ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 7578|回复: 23

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

[复制链接]

TA的精华主题

TA的得分主题

发表于 2010-4-9 13:01 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:XLA加载宏开发
本帖最后由 chrisfang 于 2014-2-15 15:31 编辑

打包上传,安装启用加载宏,点击菜单“检测更新”
test.rar (89.85 KB, 下载次数: 141)

代码见5楼



TA的精华主题

TA的得分主题

发表于 2010-4-11 12:30 | 显示全部楼层

〖Excel Home友情提示〗

   

很遗憾通知楼上朋友,您的帖子在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

TA的精华主题

TA的得分主题

发表于 2010-6-23 21:29 | 显示全部楼层
这个思路不错,还有没有下文?

TA的精华主题

TA的得分主题

 楼主| 发表于 2010-6-23 22:58 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
后来补充了,如果不能通过外网升级就通过局域网升级

TA的精华主题

TA的得分主题

 楼主| 发表于 2010-6-24 09:22 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
1、加载宏的升级过程经过改进如下:
  1. Sub update()
  2.     Dim xml6 As Object, bt() As Byte, wt As Long
  3.     Dim txtLine
  4.     Dim FileObj
  5.     Dim TextObj
  6.     Dim FilePath
  7.    
  8.     On Error Resume Next
  9.     Application.StatusBar = "正在检测新版本,请稍后......"   
  10.     Kill "d:\ver.txt"
  11.     Kill "d:\Test.exe"
  12.     Set xml6 = CreateObject("Microsoft.XMLHTTP")
  13.     URL = "http://www.xxx.com/ver.txt"
  14.     xml6.Open "GET", URL, False
  15.     xml6.send
  16.     If xml6.Status = 200 Then
  17.         bt = xml6.responseBody
  18.         Open "d:\ver.txt" For Binary As #1
  19.         Put 1, , bt
  20.         Close #1

  21.         '读取TXT文件内容
  22.         Set fs = CreateObject("Scripting.FileSystemObject")
  23.         Set ts = fs.GetFile("d:\ver.txt").OpenAsTextStream(1, 0)
  24.         s = Mid(ts.ReadLine, 4, Len(ts.ReadLine) + 3)
  25.         ts.Close
  26.         '判断版本是否一致
  27.         If VBA.Val(Replace(s, ".", "")) <= VBA.Val(Replace(Version, ".", "")) Then
  28.            Kill "d:\ver.txt"
  29.            MsgBox  "已是最新版本,有问题请反馈给作者。", vbInformation, "提示
  30.            Application.StatusBar = False
  31.         Else
  32.         '打开更新内容文件
  33.            Application.StatusBar = "发现更新文件"
  34.            Workbooks.OpenText Filename:="D:\ver.txt", StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
  35.            Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 2)
  36.            Windows("ver.txt").Activate
  37.            Response = MsgBox("当前使用版本:" & Version & Chr(10) & Chr(10) & "检测到新版本:" & s & _
  38.            Chr(10) & Chr(10) & "更新内容见当前文档说明。" & Chr(10) & Chr(10) & "是否立即升级?", _
  39.            vbYesNo + vbInformation + vbDefaultButton2, "提示")
  40.            Windows("ver.txt").Activate
  41.            ActiveWindow.Close
  42.            Kill "d:\ver.txt"

  43.            If Response = vbYes Then
  44.               Application.StatusBar = "正在下载更新文件,请稍后....."
  45.               Set xml6 = CreateObject("Microsoft.XMLHTTP")
  46.               URL = "http://www.xxx.com/test.exe"
  47.               xml6.Open "GET", URL, False
  48.               xml6.send
  49.               If xml6.Status = 200 Then
  50.                  bt = xml6.responseBody
  51.                  Open "d:\Test.exe" For Binary As #1
  52.                  Put 1, , bt
  53.                  Close #1
  54.                  MsgBox "请注意保存当前打开的Excel文檔" & Chr(10) & Chr(10) & "点击""确定""后将关闭当前文档", vbInformation, "提示
  55.                  '运行升级文件
  56.                  Workbooks.Close
  57.                  Shell "d:\Test.exe", vbNormalFocus
  58.                  Application.Quit
  59.                Else
  60.                   MsgBox "外部网络不通,无法检测更新", vbInformation, "提示
  61.               End If
  62.             Else
  63.               Application.StatusBar = False
  64.               Exit Sub
  65.             End If
  66.             Exit Sub
  67.         End If
  68.     Else
  69.            '通过局域网升级
  70.             Application.StatusBar = "网络不通,正尝试通过局域网升级......"
  71.             Set fs = CreateObject("Scripting.FileSystemObject")
  72.             fs.copyfile "\\172.20.123.123\update\ver.txt", "d:\ver.txt"
  73.              '读取TXT文件内容
  74.             'Set fs = CreateObject("Scripting.FileSystemObject")
  75.             Set ts = fs.GetFile("d:\ver.txt").OpenAsTextStream(1, 0)
  76.             s = Mid(ts.ReadLine, 4, Len(ts.ReadLine) + 1)
  77.             ts.Close
  78.             '判断版本是否一致
  79.             If Replace(s, ".", "") <= Replace(Version, ".", "") Then
  80.                Kill "d:\ver.txt"
  81.                MsgBox "当前版本" & Version & "已是最新版本,有问题请反馈给作者。", vbInformation, "提示
  82.                Application.StatusBar = False
  83.             Else
  84.                 '打开更新内容文件
  85.                Application.StatusBar = "发现更新文件"
  86.                Workbooks.OpenText Filename:="D:\ver.txt", StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
  87.                Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 2)
  88.                Windows("ver.txt").Activate
  89.                Response = MsgBox("当前使用版本:" & Version & Chr(10) & Chr(10) & "检测到新版本:" & s & _
  90.                Chr(10) & Chr(10) & "更新内容见当前文档说明。" & Chr(10) & Chr(10) & "是否立即升级?", _
  91.                vbYesNo + vbInformation + vbDefaultButton2, "提示")
  92.                Windows("ver.txt").Activate
  93.                ActiveWindow.Close
  94.                Kill "d:\ver.txt"

  95.                 If Response = vbYes Then
  96.                     Application.StatusBar = "正在下载更新文件,请稍后......"
  97.                     fs.copyfile "\\172.20.123.123\update\test.exe", "d:\test.exe"
  98.                     MsgBox "请注意保存当前打开的Excel文檔" & Chr(10) & Chr(10) & "点击""确定""后将关闭当前文档", vbInformation, "提示
  99.                      '运行升级文件
  100.                      Workbooks.Close
  101.                      Shell "d:\Test.exe", vbNormalFocus
  102.                      Application.Quit
  103.                 Else
  104.                     Application.StatusBar = False
  105.                     Exit Sub
  106.                 End If
  107.             End If
  108.         Else
  109.             MsgBox "外部网络不通,无法检测更新", vbInformation, "提示
  110.             Exit Sub
  111.         End If
  112. End Sub
复制代码
2、在加载宏中再设定版本号
  1. Sub ver()
  2. Version = "3.1.6.0.6.040"
  3. End Sub
复制代码
3、将加载宏用winrar打包成自解压文件
解压文件注释为
  1. Path=%userprofile%\Application Data\Microsoft\AddIns\
  2. Setup=EXCEL.EXE
  3. Overwrite=1
  4. License=提示
  5. {
  6. <center><u><b><font face=楷体_GB2312 color=red size=4> 点击“接受”前请关闭EXCEL</font></b></u></center><BR><p>
  7. <font  size=2>----------------------------------------------------------------------------------------</font><BR>
  8. <font face=楷体_GB2312 color=blue>版本号:3.1.6.0.1.040</font><BR>
  9. <P>
  10. <pre><font face=楷体_GB2312 size=3>1、更新内容请参看更新说明文档

  11. 2、更新完成后系统会自动开启Excel
  12.    请勿手工开启,以防升级失败。</font></pre>
  13. <br>
  14. <P>

  15. <font  size=2>----------------------------------------------------------------------------------------</font><BR>
  16. <font face=楷体_GB2312>更新日期:2010年6月10日</font>
  17. }
复制代码
4、升级说明档案ver.txt文件内容见附件形式
ver.zip (246 Bytes, 下载次数: 232)

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

TA的精华主题

TA的得分主题

发表于 2010-6-26 10:19 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
能否打包上来看看,这样更适合新手

TA的精华主题

TA的得分主题

发表于 2010-7-21 22:14 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2010-7-23 00:01 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2010-7-23 23:39 | 显示全部楼层
打包上传,安装启用加载宏,点击菜单“检测更新”
test.rar (89.85 KB, 下载次数: 355)

TA的精华主题

TA的得分主题

发表于 2010-7-24 22:28 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 20:09 , Processed in 0.059728 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表