Mac版Excel VBA无法访问CustomDocumentProperties问题求助

问题原因 #

微软Office for Mac最新更新中，Workbook.CustomDocumentProperties的VBA API实现出现兼容性故障，导致原有直接访问该对象的代码在Mac环境下无法正常执行，而Windows平台的API逻辑未受影响。

替代方案 #

方案1：通过AppleScript桥接访问（适配现有逻辑） #

利用VBA调用AppleScript绕开失效的VBA API，直接操作Mac版Excel的文档属性：

获取自定义属性数量

Sub GetMacCustomPropCount()
    Dim scriptStr As String
    Dim propCount As Integer
    
    scriptStr = "tell application ""Microsoft Excel""" & vbCrLf & _
                "return count of custom document properties of active workbook" & vbCrLf & _
                "end tell"
    
    propCount = MacScript(scriptStr)
    MsgBox "自定义文档属性数量：" & propCount
End Sub

遍历所有自定义属性

Sub ListMacCustomDocProps()
    Dim scriptStr As String
    Dim props As Variant
    Dim prop As Variant
    Dim rw As Integer
    
    scriptStr = "tell application ""Microsoft Excel""" & vbCrLf & _
                "set docProps to custom document properties of active workbook" & vbCrLf & _
                "set propList to {}" & vbCrLf & _
                "repeat with p in docProps" & vbCrLf & _
                "    set end of propList to {name of p, value of p}" & vbCrLf & _
                "end repeat" & vbCrLf & _
                "return propList" & vbCrLf & _
                "end tell"
    
    props = MacScript(scriptStr)
    rw = 1
    Worksheets(1).Activate
    
    If IsArray(props) Then
        For Each prop In props
            Cells(rw, 1).Value = prop(1)
            Cells(rw, 2).Value = prop(2)
            rw = rw + 1
        Next prop
    Else
        MsgBox "无自定义文档属性或访问失败"
    End If
End Sub

方案2：改用自定义XML部件存储（跨平台长期方案） #

如果需要Windows/Mac双平台稳定兼容，建议放弃依赖CustomDocumentProperties，改用Excel内置的自定义XML部件存储属性：

写入自定义属性

Sub SaveCustomProperty(key As String, value As Variant)
    Dim xmlPart As CustomXMLPart
    Dim xmlStr As String
    
    ' 查找已存在的自定义XML部件
    On Error Resume Next
    Set xmlPart = ThisWorkbook.CustomXMLParts.SelectByNamespace("http://yourdomain.com/customprops").Item(1)
    On Error GoTo 0
    
    ' 不存在则创建新部件
    If xmlPart Is Nothing Then
        xmlStr = "<customProps xmlns=""http://yourdomain.com/customprops""></customProps>"
        Set xmlPart = ThisWorkbook.CustomXMLParts.Add(xmlStr)
    End If
    
    ' 删除旧属性（避免重复）
    On Error Resume Next
    xmlPart.DeleteNodes("//*[@key='" & key & "']")
    On Error GoTo 0
    
    ' 添加新属性
    xmlStr = "<prop key='" & key & "'>" & value & "</prop>"
    xmlPart.AppendChild(xmlStr)
End Sub

读取自定义属性

Sub ReadCustomProperty(key As String)
    Dim xmlPart As CustomXMLPart
    Dim nodes As CustomXMLNodes
    Dim propValue As String
    
    On Error Resume Next
    Set xmlPart = ThisWorkbook.CustomXMLParts.SelectByNamespace("http://yourdomain.com/customprops").Item(1)
    On Error GoTo 0
    
    If Not xmlPart Is Nothing Then
        Set nodes = xmlPart.SelectNodes("//*[@key='" & key & "']")
        If nodes.Count > 0 Then
            propValue = nodes(1).Text
            MsgBox key & "：" & propValue
        Else
            MsgBox "未找到属性：" & key
        End If
    Else
        MsgBox "无自定义属性存储"
    End If
End Sub

获取属性数量

Sub GetCustomPropCount()
    Dim xmlPart As CustomXMLPart
    Dim nodes As CustomXMLNodes
    
    On Error Resume Next
    Set xmlPart = ThisWorkbook.CustomXMLParts.SelectByNamespace("http://yourdomain.com/customprops").Item(1)
    On Error GoTo 0
    
    If Not xmlPart Is Nothing Then
        Set nodes = xmlPart.SelectNodes("//prop")
        MsgBox "自定义属性数量：" & nodes.Count
    Else
        MsgBox "无自定义属性存储"
    End If
End Sub

说明：方案1可快速适配原有代码逻辑，方案2从根源上解决跨平台兼容性问题，推荐长期项目使用。

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