VBA程序也玩自动升级

markqin

最近用VBA帮公司其他部门的同事写了一个数据管理的小工具，让他们以前每天要花1、2个钟头处理的工作现在10几分钟就搞定，还不容易出错，博得不少喝彩
终于，这些个家伙们提出越来越多新的要求，一会要求导出的报表增加这个项目，一会要求增加那个功能。倒是难不倒咱，很快修改了窗体代码，然而他们却连导入窗体都不会操作，还得跑到他们电脑前去（办公室可不在一起呀 ）一次两次就算了，可却经常发生，又不好意思拒绝
几经尝试，终于找到了一个解决办法：
为了好看，也为了防止误操作，所有他们可见的界面都是窗体，每次要求修改的东西也都是通过修改窗体代码完成的，那么，在工具上加上个自动升级功能，每次我写好新窗体后，导出到共享盘上，文件自动查找有没有新窗体文件存在，有，则先删除原来的窗体，再导入新窗体（要求同名），不就搞定了吗？
不多说了，上代码：
Sub 升级()
Application.ScreenUpdating = False
On Error Resume Next
  Dim pw$
'因为要用代码操作窗体需要先解开VBA工程密码（无密码就不用了），先解开：
  pw = "1234" 'VBA工程密码
  If ThisWorkbook.VBProject.Protection = vbext_pp_locked Then
    Application.VBE.CommandBars(1).Controls("工具(T)").Controls("VBAProject 属性(&E)...").Execute
    Application.SendKeys pw & "{ENTER}{ENTER}"
    DoEvents
  End If

'还要求工具（T）-宏（M）-安全性（M）-可靠发行商（T）-勾选了“信任对于VB项目的访问（V），就别手工了，自动来：
  Dim Chgset As Boolean
  '陷阱测试，VBProject.Protection在这儿并无实际的意义
  Debug.Print ThisWorkbook.VBProject.Protection
  If Err.Number = 1004 Then
    Err.Clear
    Application.SendKeys "%TMS%T%V{ENTER}"
Chgset = True
DoEvents
  End If
  '执行升级操作：
Dim vbCmp As VBComponent
Dim fname As String
  For Each vbCmp In ThisWorkbook.VBProject.VBComponents
    If vbCmp.Type = vbext_ct_MSForm Then 'ThisWorkbook.VBProject.VBComponents.Remove vbCmp
    fname = vbCmp.Name
    If Dir("共享路径\" & fname & ".frm") <> "" Then
    Application.VBE.ActiveVBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(fname)
    Application.VBE.ActiveVBProject.VBComponents.Import " 共享路径\"  & fname & ".frm"
    End If
    End If
  Next vbCmp
  MsgBox "升级完成"
  
  '操作完成后还原操作前的状态
Application.ScreenUpdating = True
If Chgset Then Application.SendKeys "%TMS%T%V{ENTER}"
End Sub

当然了，这里是直接开始升级了，如果需要，加上个升级文件是否存在的判断也行。

minjiwei

收藏了。不错，蛮有意思的

TeF

比较新颖的思路。收藏了

sunsoncheng

有点意思,作个记号
还要引用什么呢?

[ 本帖最后由 sunsoncheng 于 2009-1-11 14:22 编辑 ]

mayiwan

新颖  赞一个先

itxianfeng

标记的地方是用于共享的，共享升级，就像杀毒软件的网络升级一样，扩展无极限，思路很好。

hanter007

这样也行啊..呵呵..厉害..看有没有机会用上..谢谢分享

mayiwan

好资料顶起
让更多的人能看到！~~

刘志文

不错，向你学习!!