Excel VBA中如何引用版本可变的ChemDrawCtl对象库？

针对你需要兼容不同版本ChemDraw组件的需求，现有循环遍历版本号的实现可以从兼容性、可读性、鲁棒性三个维度优化，以下是两种更规范的实现方式：

基础优化版：优先无版本ProgID+精准缓存 #

很多COM组件支持不带版本号的ProgID（指向当前系统默认版本），这是最简洁的兼容方式，再配合缓存机制避免重复查找：

Option Explicit

Function NewChemDrawCtl() As Object
    Static successfulProgID As String
    Dim candidateProgIDs As Variant
    Dim progID As Variant
    
    ' 优先复用已成功的ProgID
    If successfulProgID <> "" Then
        On Error Resume Next
        Set NewChemDrawCtl = CreateObject(successfulProgID)
        On Error GoTo 0
        If Not NewChemDrawCtl Is Nothing Then Exit Function
        ' 缓存失效则清空，重新查找
        successfulProgID = ""
    End If
    
    ' 候选ProgID列表：先试无版本，再从高到低遍历主流版本
    candidateProgIDs = Array( _
        "ChemDrawControl.ChemDrawCtl", _
        "ChemDrawControl50.ChemDrawCtl", "ChemDrawControl49.ChemDrawCtl", _
        "ChemDrawControl40.ChemDrawCtl", "ChemDrawControl30.ChemDrawCtl", _
        "ChemDrawControl20.ChemDrawCtl", "ChemDrawControl19.ChemDrawCtl", _
        "ChemDrawControl18.ChemDrawCtl", "ChemDrawControl17.ChemDrawCtl", _
        "ChemDrawControl16.ChemDrawCtl", "ChemDrawControl15.ChemDrawCtl" _
    )
    
    ' 遍历尝试初始化
    For Each progID In candidateProgIDs
        On Error Resume Next
        Set NewChemDrawCtl = CreateObject(progID)
        On Error GoTo 0
        If Not NewChemDrawCtl Is Nothing Then
            successfulProgID = progID
            Exit Function
        End If
    Next progID
    
    ' 所有尝试失败时抛出明确错误
    Err.Raise vbObjectError + 1001, , "无法找到可用的ChemDrawCtl组件"
End Function

优化点说明 #

• 优先无版本ProgID：避免不必要的版本遍历，大部分场景下直接命中当前系统默认版本
• 缓存实际ProgID：缓存成功初始化的完整ProgID而非版本号，后续调用直接复用，且能自动处理版本变更后的缓存失效
• 严谨错误处理：仅在CreateObject时临时忽略错误，其余代码恢复正常错误检测，避免隐藏其他逻辑问题
• 明确候选范围：只列实际存在的主流版本，减少无效遍历

进阶版：自动检测已安装版本 #

通过读取注册表自动获取系统中已注册的ChemDraw组件版本，无需硬编码版本号，适配所有已安装版本：

Option Explicit

Function GetInstalledChemDrawProgIDs() As Variant
    Dim regKey As Object
    Dim subKeys As Variant
    Dim i As Long
    Dim progIDs As Collection
    
    Set progIDs = New Collection
    
    ' 初始化注册表访问对象
    On Error Resume Next
    Set regKey = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    On Error GoTo 0
    
    If regKey Is Nothing Then
        GetInstalledChemDrawProgIDs = Array()
        Exit Function
    End If
    
    ' 读取HKEY_CLASSES_ROOT下所有ChemDrawControl开头的子键
    regKey.EnumKey &H80000000, "", subKeys ' &H80000000对应HKEY_CLASSES_ROOT
    
    If Not IsEmpty(subKeys) Then
        For i = LBound(subKeys) To UBound(subKeys)
            If InStr(1, subKeys(i), "ChemDrawControl", vbTextCompare) = 1 Then
                ' 验证是否存在对应的ChemDrawCtl子键
                On Error Resume Next
                regKey.EnumKey &H80000000, subKeys(i) & ".ChemDrawCtl", vbNull
                If Err.Number = 0 Then
                    progIDs.Add subKeys(i) & ".ChemDrawCtl"
                End If
                On Error GoTo 0
            End If
        Next i
    End If
    
    ' 将无版本ProgID插入到列表最前面
    progIDs.Add "ChemDrawControl.ChemDrawCtl", , 1
    
    ' 转换为数组返回
    Dim result() As String
    ReDim result(1 To progIDs.Count)
    For i = 1 To progIDs.Count
        result(i) = progIDs(i)
    Next i
    
    GetInstalledChemDrawProgIDs = result
End Function

Function NewChemDrawCtl() As Object
    Static successfulProgID As String
    Dim candidateProgIDs As Variant
    Dim progID As Variant
    
    ' 复用缓存的ProgID
    If successfulProgID <> "" Then
        On Error Resume Next
        Set NewChemDrawCtl = CreateObject(successfulProgID)
        On Error GoTo 0
        If Not NewChemDrawCtl Is Nothing Then Exit Function
        successfulProgID = ""
    End If
    
    ' 获取系统中已安装的所有ChemDraw ProgID
    candidateProgIDs = GetInstalledChemDrawProgIDs()
    
    If UBound(candidateProgIDs) < LBound(candidateProgIDs) Then
        Err.Raise vbObjectError + 1001, , "未检测到已安装的ChemDraw组件"
        Exit Function
    End If
    
    ' 遍历尝试初始化
    For Each progID In candidateProgIDs
        On Error Resume Next
        Set NewChemDrawCtl = CreateObject(progID)
        On Error GoTo 0
        If Not NewChemDrawCtl Is Nothing Then
            successfulProgID = progID
            Exit Function
        End If
    Next progID
    
    Err.Raise vbObjectError + 1002, , "无法初始化ChemDrawCtl组件"
End Function

进阶方案优势 #

• 完全自动适配：无需关注版本号变化，自动检测所有已注册的ChemDraw组件
• 鲁棒性更强：支持非常新或非常旧的版本，避免硬编码版本号的遗漏问题
• 动态生成候选列表：只尝试系统中实际存在的ProgID，效率更高

注意事项 #

1. 后期绑定会失去IntelliSense和编译时类型检查，建议开发阶段用早期绑定调试，发布时切换为后期绑定
2. 确保用户系统中已安装ChemDraw且组件已正确注册（若未注册，可通过regsvr32.exe手动注册组件）
3. 进阶方案需要WMI权限，普通用户默认拥有该权限，受限环境需提前验证

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