vba upgradeITeye - AG环亚娱乐集团

vba upgradeITeye

2019年03月28日11时07分26秒 | 作者: 鸿光 | 标签: 文件,程序,晋级 | 浏览: 2011

本程序的版别号从1开端,逐次加大
发布新版别后,除了将新版别放到下载目录中外,还要删去原文件或改名,程序在晋级时找不到原旧文件名,才会向上推新的带版别号的文件名进行下载

Declare 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
Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

Function CheckUrl(Url As String) As Boolean  检测网络文件是否存在
  Dim XMLObject As Object
  Set XMLObject = CreateObject("Microsoft.XMLHTTP")
  XMLObject.Open "GET", Url, False
  XMLObject.send ""
  If XMLObject.Status = 200 Then
  CheckUrl = True
  Else
  CheckUrl = False
  End If
  Set XMLObject = Nothing
End Function

Sub MyUpgrade()  下载晋级EXCEL的主程序
  Dim PathStr As String, NewFileUrl As String, DownOk As Long, Vers%, i%, UrlPath$, FileName$, NewVers%
  Vers = Val(ThisWorkbook.BuiltinDocumentProperties("Category").Value)  获取现有版别号,这个版别号写在文件的特点里,避免影响文件结构
  UrlPath = "http://222.209.208.142:81/UpFiles/"  这是程序晋级网址的URL途径,可根据您的途径修正
  FileName = "我的程序名.xls"  这是原文件名,可根据您的程序名修正,用户改文件名,对此晋级无影响
  NewFileUrl = UrlPath Vers FileName  当时版别的完好地址
  PathStr = ThisWorkbook.FullName

  If CheckUrl(NewFileUrl) = False Then  假如没有在晋级网址找到当时版别,那么阐明有新版别
  For i = Vers To Vers + 50  持续查找新版别号,为了节省时间,所以只从当时版别号开端向上推50个版别号,假如超越50个版别都没升过级,那你也不是经常用
  NewFileUrl = UrlPath i FileName
  If CheckUrl(NewFileUrl) = True Then
  NewVers = i
  Exit For  假如找到新的程序文件了就退出查找
  End If
  Next
  If NewVers Vers Then  此条件阐明找到有新版别
  If MsgBox("检测到有新版别,是否当即晋级?", vbYesNo + vbInformation, "晋级") = vbNo Then Exit Sub
  ThisWorkbook.ChangeFileAccess xlReadOnly  设为只读后才可对原旧文件进行操作
  Kill PathStr最好不要删去文件,晋级成功后让用户自己手动删去,这儿选用改名法,否则会重名过错
  Name PathStr As ThisWorkbook.Path "\" Replace(ThisWorkbook.Name, ".xls", "") "(原文件).xls"
  DownOk = URLDownloadToFile(0, NewFileUrl, PathStr, 0, 0)  下载的文件以原旧文件命名
  Call DeleteUrlCacheEntry(NewFileUrl)  用这个删去缓存中下载的新程序文件,能够不要
  MsgBox "晋级成功"
  ThisWorkbook.Close False 封闭文件,当然您能够不关而进行下面搬运数据的作业
  这儿参加仿制旧文件的数据到新文件中的代码,假如EXCEL程序与其数据是分隔寄存的,则更好
  End If
  End If
End Sub

Sub Issue()  发布新版别,程序发布者专用,将生成的新文件放到下载目录里,有必要删去旧文件
  With ThisWorkbook
  .BuiltinDocumentProperties("Category").Value = Val(.BuiltinDocumentProperties("Category").Value) + 1 "为当时版别号"
  .Save
  .ChangeFileAccess xlReadOnly
  Name ThisWorkbook.FullName As ThisWorkbook.Path "\" Val(ThisWorkbook.BuiltinDocumentProperties("Category").Value) "我的程序名.xls"
  MsgBox "发布成功"
  .Close False
  End With
End Sub

转自Jack.zhou.xmzdy@qq.com


版权声明
本文来源于网络,版权归原作者所有,其内容与观点不代表AG环亚娱乐集团立场。转载文章仅为传播更有价值的信息,如采编人员采编有误或者版权原因,请与我们联系,我们核实后立即修改或删除。

猜您喜欢的文章

阅读排行

  • 1

    vba upgradeITeye

    文件,程序,晋级
  • 2

    java 多线程ITeye

    线程,作业,内存
  • 3
  • 4

    ClassLoaderITeye

    运用,文件,办法
  • 5
  • 6

    手机号码校验合法性ITeye

    代表,必定,第二位
  • 7
  • 8

    Java 目标巨细的核算ITeye

    目标,巨细,字节
  • 9
  • 10