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
           

此函數對應的表結構如下：大家可以根據自己的程式來建構合适的資料源：

運作結果：

這樣子調用此函數即可：