升级前提是要有一个服务器或者直链下载空间，用于存放新版本URL直链的xlsm宏文件和网络版本号.txt

思路：1，新版本URL直链的xlsm宏文件和网络版本号.txt放到服务器上或者直链下载空间里。

2，新版本URL直链的xlsm宏文件用一个不常用单元格用于存放新版本号，比如Sheets(3).[a10000]写入：V1.0，这个版本号必须和网络版本号.txt里面的一致，以便多个版本比对更新。

4，先到服务器上或者直链下载空间里打开网络版本号.txt，更改最新版本号，并同步把这个版本号写入新版本URL直链的xlsm宏文件的Sheets(3).[a10000]中

5，本地启动工作薄后在workbookopen事件中，先下载网络版本号.txt，取出最新版本号，后和旧版本的Sheets(3).[a10000]里面的版本号作对比，下载新版本URL直链的xlsm宏文件，旧xlsm宏文件销毁自身，实现更新。

具体实现代码

'下载和清空缓存api函数申明
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szExtName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Public Sub 升级主程序()
Dim e, h As IntegerDim fso As FileSystemObjectSet fso = CreateObject("Scripting.FileSystemObject")'--------------------------------------------------------------------------------------------------------------------------删除上次下载的相关文件If fso.FileExists(Application.DefaultFilePath & "\网络版本号.txt") = True Then '删除之前的网络版本号fso.DeleteFile Application.DefaultFilePath & "\网络版本号.txt", TrueEnd IfSet fso = Nothing'---------------------------------------------------------------------------------------------------------------------------Dim a As IntegerDim strURL As StringDim strPath As StringDim intRetVal As IntegerOn Error Resume Next'-------------------------------------------------下载网络版本号strURL = "http://f.travelly.store:9999/1/dwlde123/%E5%B9%BC%E5%84%BF%E5%9B%AD%E7%BD%91%E7%BB%9C%E7%89%88%E6%9C%AC%E5%8F%B7.txt" '网络文件位置strPath = Application.DefaultFilePath & "\网络版本号.txt" '本地文件位置intRetVal = URLDownloadToFile(0, strURL, strPath, 0, 0) '下载DeleteUrlCacheEntry (strURL) '清空缓存'--------------------------------------------------------------------------------判断网络版本号是否下载完成For e = 1 To 10Application.Wait (Now + TimeValue("0:00:01")) '每隔1秒判断一次下载是否完成Dim fso1 As FileSystemObjectSet fso1 = CreateObject("Scripting.FileSystemObject")If fso1.FileExists(Application.DefaultFilePath & "\网络版本号.txt") = True Then '如果网络版本号下载下来了，就跳出循环往下执行Set fso1 = NothingExit ForEnd Ifh = h + 1 '累计下载用时Next eDim fso2 As FileSystemObjectSet fso2 = CreateObject("Scripting.FileSystemObject")If h > 9 And fso2.FileExists(Application.DefaultFilePath & "\网络版本号.txt") = False Then '如果10秒后网络版本号还未下载下来,提示用户检查网络是否畅通MsgBox "你的电脑网络不通,请关闭文件后检查网络，本程序需联网运行!请让电脑联网，否则将得不到最新版而影响数据准确"Set fso2 = NothingExit SubEnd If'-----------------------------------判断网络版本号与本地版本号是否一致bendi = ThisWorkbook.Sheets(3).[a50].Value '得到本地版本号Open Application.DefaultFilePath & "\网络版本号.txt" For Input As #3Input #3, wangluo '得到网络版本号Close #3
If bendi <> wangluo Then '如果本地版本号和网络版本号不一致,就要下载升级文件进行下载MsgBox "发现新版本,点确定开始升级"On Error GoTo 102'---------------------------升级文件下载strURL = "http://f.travelly.store:9999/1/dwlde123/%E5%B9%BC%E5%84%BF%E5%9B%AD%E6%95%B0%E6%8D%AE%E7%94%9F%E6%88%90.xlsm"strPath = Application.DefaultFilePath & "\自动化.xlsm"intRetVal = URLDownloadToFile(0, strURL, strPath, 0, 0)DeleteUrlCacheEntry (strURL) '清空缓存'--------------------------------------------------------------------------------判断升级文件是否下载完成
102:For e = 1 To 80Application.Wait (Now + TimeValue("0:00:01")) '每隔1秒判断一次下载是否完成Dim fso3 As FileSystemObjectSet fso3 = CreateObject("Scripting.FileSystemObject")If fso3.FileExists(Application.DefaultFilePath & "\自动化.xlsm") = True Then  '如果升级文件下载下来了调用更新模块Set fso3 = NothingDim s As Strings = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now)Name Application.DefaultFilePath & "\自动化.xlsm" As Application.DefaultFilePath & "\自动化" & s & ".xlsm" '移动文件fso2.MoveFile Application.DefaultFilePath & "\自动化" & s & ".xlsm", ThisWorkbook.Path & "\"更新模块 '调用模块销毁自身Exit SubEnd Ifh = h + 1 '累计下载用时Next eIf h > 78 Then '如果58秒后未下载下来,提示用户检查网络是否畅通MsgBox "你的电脑网络不通,请关闭文件后检查网络，本程序需联网运行!请让电脑联网，否则将得不到最新版而影响数据准确"Exit SubEnd IfEnd If
End Sub
Public Sub 更新模块()'销毁自身模块
On Error Resume Next
MsgBox "升级成功，请在当前文件夹寻找新版本"
With ThisWorkbook '销毁自身
.Saved = True
.ChangeFileAccess xlReadOnlyKill .FullName
.Close
End With
End Sub