局域网内vba程序更新的代码-----路径自己改

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Declare PtrSafe Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long

Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

Sub AutoUpdate()

    Sheets("total").[a1].Select

    Dim con As New ADODB.Connection

    con.Open "provider=microsoft.ace.oledb.12.0;data source =C:\Users\Administrator\Desktop\net\版本号.accdb"

    Dim sql$

    sql = "select 版本号 from 版本号"

    Dim rs As New ADODB.Recordset

    Set rs = con.Execute(sql)

    Sheets("total").Range("an3").CopyFromRecordset rs

    rs.Close: Set rs = Nothing

    con.Close: Set con = Nothing

    If Sheets("total").[an2] <> Sheets("total").[an3] Then

        Sheets("total").[an3].Copy Sheets("total").[an2]

        MsgBox "发现新版本，点确定开始更新"

        On Error Resume Next

        Dim url As String, save_path As String, isdown As Long, fso As Object

        Set fso = CreateObject("Scripting.FileSystemObject")

   

        If fso.FileExists(旧版文件路径) = True Then

            fso.DeleteFile 旧版文件路径, True

        End If

        Dim folderPath As String

        folderPath = "C:\Users\Administrator\Desktop\Tempsave_path"

        If Len(Dir(folderPath, vbDirectory)) = 0 Then MkDir folderPath

        

        url = 局域网内文件路径

        Tempsave_path = "C:\Users\Administrator\Desktop\Tempsave_path" & "\" & fso.GetFileName(url)

        isdown = URLDownloadToFile(0, url, Tempsave_path, 0, 0)

        DeleteUrlCacheEntry (url)

        

        If Workbooks.Count = 1 Then

            Application.Quit

        End If

        MsgBox "更新完成!,新版在\C:\Users\Administrator\Desktop\Tempsave_path文件夹中,请剪切至桌面在使用!"

        With ThisWorkbook

            .Saved = True

            .ChangeFileAccess xlReadOnly

            Kill .FullName

            .Close

        End With

        ThisWorkbook.Close

        Exit Sub

    Else

        Sheets("total").[a1].Select

    End If

End Sub