加载宏自动升级(打包测试文件)

flydove · 发表于 2010-4-9 13:01

本帖最后由 chrisfang 于 2014-2-15 15:31 编辑

打包上传，安装启用加载宏，点击菜单“检测更新”

test.rar (89.85 KB, 下载次数: 145)

代码见5楼

Admin · 发表于 2010-4-11 12:30

很遗憾通知楼上朋友，您的帖子在24小时之内没有任何回复！

通常情况下，本论坛发布的主题帖会在8小时被回复或处理。您的帖子在24小时之内未被回复，其中的原因可能是：

1、问题表述不清、模棱两可，难以理解，帮助者被搞晕了，夺帖而出；
2、没有上传必要的附件，或附件被遗忘在某个角落；
3、发帖提问时，语气带棱角、带挑衅，不幸被列入不受欢迎的帖子；
4、所提问题不成立，或提不合理的要求，乐于助人者使出“走为上”之计；
5、话题较偏、较冷或者发布到了不合适的版块，暂时无人问津，顾影自怜。

为了提高您的问题解决效率，我们推荐您阅读以下文章：
* 如何发表新话题和上传附件：http://club.excelhome.net/thread-45649-1-1.html
* 发帖的技巧：http://club.excelhome.net/thread-176339-1-1.html
* EH技术论坛的最佳学习方法：http://club.excelhome.net/thread-117862-1-1.html

abao2005 · 发表于 2010-6-23 21:29

这个思路不错，还有没有下文？

flydove · 发表于 2010-6-23 22:58

后来补充了，如果不能通过外网升级就通过局域网升级

flydove · 发表于 2010-6-24 09:22

1、加载宏的升级过程经过改进如下：

Sub update()
Dim xml6 As Object, bt() As Byte, wt As Long
Dim txtLine
Dim FileObj
Dim TextObj
Dim FilePath
On Error Resume Next
Application.StatusBar = "正在检测新版本，请稍后......"
Kill "d:\ver.txt"
Kill "d:\Test.exe"
Set xml6 = CreateObject("Microsoft.XMLHTTP")
URL = "http://www.xxx.com/ver.txt"
xml6.Open "GET", URL, False
xml6.send
If xml6.Status = 200 Then
bt = xml6.responseBody
Open "d:\ver.txt" For Binary As #1
Put 1, , bt
Close #1
'读取TXT文件内容
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.GetFile("d:\ver.txt").OpenAsTextStream(1, 0)
s = Mid(ts.ReadLine, 4, Len(ts.ReadLine) + 3)
ts.Close
'判断版本是否一致
If VBA.Val(Replace(s, ".", "")) <= VBA.Val(Replace(Version, ".", "")) Then
Kill "d:\ver.txt"
MsgBox "已是最新版本，有问题请反馈给作者。", vbInformation, "提示
Application.StatusBar = False
Else
'打开更新内容文件
Application.StatusBar = "发现更新文件"
Workbooks.OpenText Filename:="D:\ver.txt", StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 2)
Windows("ver.txt").Activate
Response = MsgBox("当前使用版本：" & Version & Chr(10) & Chr(10) & "检测到新版本：" & s & _
Chr(10) & Chr(10) & "更新内容见当前文档说明。" & Chr(10) & Chr(10) & "是否立即升级？", _
vbYesNo + vbInformation + vbDefaultButton2, "提示")
Windows("ver.txt").Activate
ActiveWindow.Close
Kill "d:\ver.txt"
If Response = vbYes Then
Application.StatusBar = "正在下载更新文件，请稍后....."
Set xml6 = CreateObject("Microsoft.XMLHTTP")
URL = "http://www.xxx.com/test.exe"
xml6.Open "GET", URL, False
xml6.send
If xml6.Status = 200 Then
bt = xml6.responseBody
Open "d:\Test.exe" For Binary As #1
Put 1, , bt
Close #1
MsgBox "请注意保存当前打开的Excel文檔" & Chr(10) & Chr(10) & "点击""确定""后将关闭当前文档", vbInformation, "提示
'运行升级文件
Workbooks.Close
Shell "d:\Test.exe", vbNormalFocus
Application.Quit
Else
MsgBox "外部网络不通，无法检测更新", vbInformation, "提示
End If
Else
Application.StatusBar = False
Exit Sub
End If
Exit Sub
End If
Else
'通过局域网升级
Application.StatusBar = "网络不通，正尝试通过局域网升级......"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.copyfile "\\172.20.123.123\update\ver.txt", "d:\ver.txt"
'读取TXT文件内容
'Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.GetFile("d:\ver.txt").OpenAsTextStream(1, 0)
s = Mid(ts.ReadLine, 4, Len(ts.ReadLine) + 1)
ts.Close
'判断版本是否一致
If Replace(s, ".", "") <= Replace(Version, ".", "") Then
Kill "d:\ver.txt"
MsgBox "当前版本" & Version & "已是最新版本，有问题请反馈给作者。", vbInformation, "提示
Application.StatusBar = False
Else
'打开更新内容文件
Application.StatusBar = "发现更新文件"
Workbooks.OpenText Filename:="D:\ver.txt", StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 2)
Windows("ver.txt").Activate
Response = MsgBox("当前使用版本：" & Version & Chr(10) & Chr(10) & "检测到新版本：" & s & _
Chr(10) & Chr(10) & "更新内容见当前文档说明。" & Chr(10) & Chr(10) & "是否立即升级？", _
vbYesNo + vbInformation + vbDefaultButton2, "提示")
Windows("ver.txt").Activate
ActiveWindow.Close
Kill "d:\ver.txt"
If Response = vbYes Then
Application.StatusBar = "正在下载更新文件，请稍后......"
fs.copyfile "\\172.20.123.123\update\test.exe", "d:\test.exe"
MsgBox "请注意保存当前打开的Excel文檔" & Chr(10) & Chr(10) & "点击""确定""后将关闭当前文档", vbInformation, "提示
'运行升级文件
Workbooks.Close
Shell "d:\Test.exe", vbNormalFocus
Application.Quit
Else
Application.StatusBar = False
Exit Sub
End If
End If
Else
MsgBox "外部网络不通，无法检测更新", vbInformation, "提示
Exit Sub
End If
End Sub

复制代码

2、在加载宏中再设定版本号

Sub ver()
Version = "3.1.6.0.6.040"
End Sub

复制代码

3、将加载宏用winrar打包成自解压文件
解压文件注释为

Path=%userprofile%\Application Data\Microsoft\AddIns\
Setup=EXCEL.EXE
Overwrite=1
License=提示
{
<center> 点击“接受”前请关闭EXCEL</center>
----------------------------------------------------------------------------------------
版本号：3.1.6.0.1.040
<pre>1、更新内容请参看更新说明文档
2、更新完成后系统会自动开启Excel
请勿手工开启，以防升级失败。</pre>
----------------------------------------------------------------------------------------
更新日期：2010年6月10日
}

复制代码

4、升级说明档案ver.txt文件内容见附件形式

ver.zip (246 Bytes, 下载次数: 238)

[ 本帖最后由 flydove 于 2010-6-24 09:29 编辑 ]

yong119 · 发表于 2010-6-26 10:19

能否打包上来看看，这样更适合新手

H2598 · 发表于 2010-7-21 22:14

能否打包上来看看

赵国辉 · 发表于 2010-7-23 00:01

有时间研究下

flydove · 发表于 2010-7-23 23:39

打包上传，安装启用加载宏，点击菜单“检测更新”

test.rar (89.85 KB, 下载次数: 356)

zjx10 · 发表于 2010-7-24 22:28

好东西，我一定要收藏！

		自动登录	找回密码
密码			免费注册

[分享] 加载宏自动升级(打包测试文件)

〖Excel Home友情提示〗