未来博客

未来是简单的

VBA判断引用库是否完整并自动修复

VBA判断引用库是否完整并自动修复

作者:AntoniotheFuture

关键词:VBA,自动修复

开发平台:office

平台版本上限:2010

平台版本下限:尚未发现

开发语言:VBA

简介:我们在开发VBA程序时,经常要调用很多的库,比如说ADO,Windows命令行这些引用,但是如果用户的机子上没有这些库,打开我们的程序就会报错,为了避免这种情况发生,或者减少我们与用户沟通的成本,我们可以用到下面的一个函数:


Public Function CheckVBA() As Integer

Dim Str1 As String
Dim str2 As String
CheckVBA = 1


'检查三次
For iii = 1 To 3
For ii = 2 To Sheet6.UsedRange.Rows.Count
    Sheet6.Cells(ii, 8) = 0
    For i = 1 To ActiveWorkbook.VBProject.References.Count
        With ActiveWorkbook.VBProject.References(i)
            If .GUID = Sheet6.Cells(ii, 2) Then
                If .IsBroken Then
                    ThisWorkbook.VBProject.References.Remove (ThisWorkbook.VBProject.References(i))
                    i = i - 1
                    '尝试自动修复
                    If Dir(Sheet6.Cells(ii, 9), vbDirectory) = "" Then
                        Sheet6.Cells(ii, 8) = 2
                    Else
                        ThisWorkbook.VBProject.References.AddFromFile "Sheet6.Cells(ii, 9)"
                    End If
                ElseIf .Major < Sheet6.Cells(ii, 3) Then
                    Sheet6.Cells(ii, 8) = 3
                ElseIf .Major = Sheet6.Cells(ii, 3) And .Minor < Sheet6.Cells(ii, 4) Then
                    Sheet6.Cells(ii, 8) = 4
                Else
                    Sheet6.Cells(ii, 8) = 1
                End If
            End If
        End With
    Next
Next
Next
Str1 = "检测到你的电脑缺失以下组件且无法自动修复,请点击确定查看网页教程:"
str2 = ""

For ii = 2 To Sheet6.UsedRange.Rows.Count
    Select Case Sheet6.Cells(ii, 8)
    Case 0
        str2 = str2 & Chr(10) & "不存在:" & Sheet6.Cells(ii, 1)
    Case 2
        str2 = str2 & Chr(10) & "损坏:" & Sheet6.Cells(ii, 1)
    Case 3
        str2 = str2 & Chr(10) & "版本太低:" & Sheet6.Cells(ii, 1)
    Case 4
        str2 = str2 & Chr(10) & "版本可能太低:" & Sheet6.Cells(ii, 1)
    End Select
Next

If Not str2 = "" Then
    CheckVBA = 0
    If MsgBox(Str1 & str2, vbYesNo, "检查组件") = vbYes Then
        For ii = 2 To Sheet6.UsedRange.Rows.Count
            If Not Sheet6.Cells(ii, 8) = 1 Then
                ActiveWorkbook.FollowHyperlink (Sheet6.Cells(ii, 7))
            End If
        Next
    End If
End If


End Function

此函数对应的表结构如下:大家可以根据自己的程序来构建合适的数据源:



运行结果:



这样子调用此函数即可:



阅读更多
文章标签: VBA 自动修复
上一篇特殊网页爬虫——VBA开发文档
下一篇单片机初级应用:时钟+闹钟+秒表+定时器
想对作者说点什么? 我来说一句

没有更多推荐了,返回首页

关闭
关闭