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

最新推荐文章于 2024-09-20 19:35:51 发布

Antonio·Future

最新推荐文章于 2024-09-20 19:35:51 发布

阅读量3.2k

点赞数 3

分类专栏： # VBA.综合应用文章标签： VBA 自动修复

本文链接：https://blog.csdn.net/qq_15041159/article/details/79952305

版权

VBA.综合应用专栏收录该内容

10 篇文章 1 订阅

订阅专栏

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

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