vba - Excel VBA 从禁用宏的实例访问 HelpFile 属性时出现错误？

Question

我想我偶然发现了 Excel 中的一个错误 - 不过我真的很想与其他人一起验证它。

当工作簿在打开应用程序的 .AutomationSecurity 属性设置为 ForceDisable 的情况下打开时，读取 Workbook.VBProject.HelpFile 属性时会出现此错误。在这种情况下，此字符串属性返回一个(可能)格式错误的 Unicode 字符串，VBA 又会用问号显示该字符串。在其上运行 StrConv(..., vbUnicode) 可以使其再次可读，但有时会以这种方式丢失最后一个字符；这可能表明 unicode 字符串确实格式错误或类似，因此 VBA 尝试首先对其进行转换但失败。

重现此行为的步骤:

• 创建新的 Excel 工作簿
• 转到其 VBA 项目 (Alt-F11)
• 添加一个新的代码模块并向其中添加一些代码(例如 Dim a As Long)
• 输入项目的属性(菜单“工具...属性”)
• 输入“description”作为项目描述，输入“abc.hlp”作为帮助文件名
• 将工作簿另存为 .xlsb 或 .xlsm
• 关闭工作簿
• 创建新的 Excel 工作簿
• 转到其 VBA 项目 (Alt-F11)
• 添加全新的代码模块
• 将下面的代码粘贴到其中
• 调整第一行的路径，使其指向您在上面创建的文件
• 运行测试例程

要使用的代码:

Const csFilePath As String = "<path to your test workbook>"

Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
  Dim theWorkbook As Workbook
  secondExcel.AutomationSecurity = security
  Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
  Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile)
  Call MsgBox(testType & " - helpfile converted: " & StrConv(theWorkbook.VBProject.HelpFile, vbUnicode))
  Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description)
  Call theWorkbook.Close(False)
End Sub

Sub Test()
  Dim secondExcel As Excel.Application
  Set secondExcel = New Excel.Application
  Dim oldSecurity As MsoAutomationSecurity
  oldSecurity = secondExcel.AutomationSecurity

  Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)
  Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)

  secondExcel.AutomationSecurity = oldSecurity
  Call secondExcel.Quit
  Set secondExcel = Nothing
End Sub

使用 Excel 2010 时的结论:

• .无论如何，描述始终是可读的(因此并非所有字符串属性都以这种方式运行)
• 仅当禁用宏时，xlsb 和 xlsm 文件才会导致 .HelpFile 不可读
• xls 文件在所有情况下都会导致不可读的 .HelpFile (!)

这可能比这更奇怪，因为我发誓我曾经在查看此类项目的属性时在 VBE GUI 中看到过弹出的问号版本，尽管我现在无法重现该情况。

我意识到，如果有的话，这就是一种边缘情况(尽管 .xls 处理除外)，所以它可能只是被 Microsoft 的 QA 部门忽视了，但对于我当前的项目，我必须让它正常工作，并且跨 Excel 版本和工作簿格式保持一致...

其他人是否也可以对此进行测试以验证我的 Excel 安装是否正确？最好还使用另一个 Excel 版本，看看是否有区别？

希望这不会像我在这里的其他一些帖子一样成为风滚草:)也许“风滚草生成器”可能是一个很好的徽章添加......

更新

我扩展了属性列表来测试只是为了看看我还能找到什么，以及所有 VBProject 的属性(BuildFileName、Description、Filename、HelpContextID、HelpFile、Mode、Name、Protection 和 Type)中的 .HelpFile存在宏关闭时被损坏的问题。

更新2

将示例代码移植到 Word 2010 并运行，会表现出完全相同的行为 - 禁用宏时，.HelpFile 属性格式错误。似乎负责此操作的代码是 Office 范围内的，可能在共享 VBA 库模块中(正如所预期的 TBH)。

更新3

刚刚在 Excel 2007 和 2003 上进行了测试，两者也都包含此错误。我还没有安装 Excel XP 来测试它，但我可以肯定地说这个问题已经有很长的历史了:)

Answer 1

我弄乱了相关字符串的底层二进制表示形式，并发现 .HelpFile 字符串属性确实返回了格式错误的字符串。

.HelpFile 属性返回的 BSTR 表示形式(VB(A) 字符串的水下二进制表示形式)在字符串前面的 4 个字节中列出了字符串大小，但后面的内容填充的是 ASCII 表示形式，而不是VBA 所期望的 Unicode (UTF16) 表示形式。

解析返回的 BSTR 内容并自行决定最有可能使用哪种格式可以在某些情况下修复此问题。不幸的是，这里也存在另一个问题:它只适用于偶数长度的字符串...奇数长度的字符串的最后一个字符被截掉，它们的 BSTR 大小被报告为短，并且 ASCII 表示不包括最后一个字符...在这种情况下，字符串无法完全恢复。

以下代码是问题中通过此修复增强的示例代码。与原始示例代码相同的使用说明也适用于它。 RecoverString 函数执行所需的魔法来恢复字符串;) DumpMem 返回您传递给它的字符串的 50 字节内存转储；使用这个可以查看内存是如何为传入的字符串精确布局的。

Const csFilePath As String = "<path to your test workbook>"

Private Declare Sub CopyMemoryByte Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Byte, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Integer, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryDWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Long, ByVal Source As Long, ByVal Length As Integer)

Function DumpMem(text As String) As String
  Dim textAddress As LongPtr
  textAddress = StrPtr(text)
  Dim dump As String
  Dim offset As Long
  For offset = -4 To 50
    Dim nextByte As Byte
    Call CopyMemoryByte(nextByte, textAddress + offset, 1)
    dump = dump & Right("00" & Hex(nextByte), 2) & " "
  Next
  DumpMem = dump
End Function

Function RecoverString(text As String) As String
  Dim textAddress As LongPtr
  textAddress = StrPtr(text)
  If textAddress <> 0 Then
    Dim textSize As Long
    Call CopyMemoryDWord(textSize, textAddress - 4, 4)
    Dim recovered As String
    Dim foundNulls As Boolean
    foundNulls = False
    Dim offset As Long
    For offset = 0 To textSize - 1
      Dim nextByte As Byte
      Call CopyMemoryByte(nextByte, textAddress + offset, 1)
      recovered = recovered & Chr(CLng(nextByte) + IIf(nextByte < 0, &H80, 0))
      If nextByte = 0 Then
        foundNulls = True
      End If
    Next
    Dim isNotUnicode As Boolean
    isNotUnicode = isNotUnicode Mod 2 = 1
    If foundNulls And Not isNotUnicode Then
      recovered = ""
      For offset = 0 To textSize - 1 Step 2
        Dim nextWord As Integer
        Call CopyMemoryWord(nextWord, textAddress + offset, 2)
        recovered = recovered & ChrW(CLng(nextWord) + IIf(nextWord < 0, &H8000, 0))
      Next
    End If
  End If
  RecoverString = recovered
End Function

Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
  Dim theWorkbook As Workbook
  secondExcel.AutomationSecurity = security
  Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
  Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile & " - " & RecoverString(theWorkbook.VBProject.HelpFile))
  Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description & " - " & RecoverString(theWorkbook.VBProject.Description))
  Call theWorkbook.Close(False)
End Sub

Sub Test()
  Dim secondExcel As Excel.Application
  Set secondExcel = New Excel.Application
  Dim oldSecurity As MsoAutomationSecurity
  oldSecurity = secondExcel.AutomationSecurity

  Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)
  Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)

  secondExcel.AutomationSecurity = oldSecurity
  Call secondExcel.Quit
  Set secondExcel = Nothing
End Sub