Excel启用宏工作簿打开时自动添加.tlb类型库引用的问题

Hey there, let's break down why your code isn't adding the qms.tlb reference when the workbook opens, and how to fix it.

Why It's Not Working #

The core issue here is Excel's macro security settings. By default, Excel blocks VBA code from modifying the VBProject object (which includes adding references) to prevent malicious code from tampering with your VBA project. Even though your message box shows up, the AddFromFile line gets silently blocked by the trust center.

Step-by-Step Solutions #

1. Enable VBA Project Object Model Access (Client-Side Setting) #

First, the user needs to adjust their Excel trust settings to allow this kind of operation. Here's how:

• Open Excel, go to File > Options > Trust Center > Trust Center Settings > Macro Settings
• Check the box labeled "Trust access to the VBA project object model"
• Click OK to save changes

⚠️ Note: This is a global setting for Excel, so remind users to only enable this if they trust the workbook and its source.

2. Fix and Optimize Your VBA Code #

Your original code has a few small bugs (like mismatched variable names) and can be cleaned up for reliability. Here's the revised version:

Private Sub Workbook_Open()
    Dim isTLBReferenced As Boolean
    Dim ref As Object ' Use Object to avoid needing early binding
    Dim question As VbMsgBoxResult
    Dim tlbPath As String
    
    ' Check if qms.tlb is already referenced
    isTLBReferenced = False
    For Each ref In ThisWorkbook.VBProject.References
        If LCase(Right(ref.FullPath, 7)) = "qms.tlb" Then
            isTLBReferenced = True
            Exit For ' No need to loop further once found
        End If
    Next ref
    
    ' Exit if already referenced
    If isTLBReferenced Then Exit Sub
    
    ' Prompt user to add reference
    question = MsgBox("This template requires the qms.tlb type library to function properly. Would you like to add it now?", _
                      vbYesNo + vbQuestion, "Missing Reference")
    If question = vbNo Then Exit Sub
    
    ' Set path to qms.tlb (handle unsaved workbook case)
    If ThisWorkbook.Path = "" Then
        MsgBox "Please save the workbook first before adding the reference.", vbExclamation
        Exit Sub
    End If
    tlbPath = ThisWorkbook.Path & "\Reference\qms.tlb"
    
    ' Add reference with error handling
    On Error Resume Next
    ThisWorkbook.VBProject.References.AddFromFile tlbPath
    If Err.Number <> 0 Then
        MsgBox "Failed to add reference: " & Err.Description & vbCrLf & "Check if qms.tlb exists at: " & tlbPath, vbCritical
        Err.Clear
    Else
        MsgBox "Reference added successfully!", vbInformation
    End If
    On Error GoTo 0
End Sub

Key Improvements:

• Fixed variable name mismatch (your original code used isDLLRegistered instead of isDLLReferenced)
• Used ThisWorkbook instead of ActiveWorkbook to target the current workbook reliably
• Added error handling to catch issues like missing .tlb files
• Handled the case where the workbook hasn't been saved (so Path is empty)
• Removed redundant GoTo statements for cleaner, easier-to-read code
• Used explicit VbMsgBoxResult type for clarity

Is This Feasible? #

Yes, it's absolutely feasible—but only if the user enables the "Trust access to the VBA project object model" setting. Without that permission, Excel will block the reference addition no matter what code you write.

内容的提问来源于stack exchange，提问作者JohnG79