Excel VBA错误从macros禁用的实例访问HelpFile属性?

我想我已经偶然发现了一个Excel中的错误 – 但是我真的很想和其他人一起validation。

当打开工作簿时打开应用程序的.AutomationSecurity属性设置为ForceDisable读取Workbook.VBProject.HelpFile属性时发生错误。 在这种情况下,这个string属性返回一个(可能)格式错误的Unicodestring,而VBA又会显示带有问号的string。 在其上运行StrConv(…,vbUnicode)使其可以再次读取,但有时这样会丢失最后一个字符。 这可能表明unicodestring确实是格式不正确的,所以VBA因此试图首先将其转换并失败。

重现此行为的步骤:

  • 创build一个新的Excel工作簿
  • 转到它的VBA项目(Alt-F11)
  • 添加一个新的代码模块并添加一些代码(比如Dim a As Long
  • input项目的属性(菜单Tools …属性)
  • input“description”作为项目描述,input“abc.hlp”作为帮助文件名称
  • 将工作簿保存为.xlsb或.xlsm
  • closures工作簿
  • 创build一个新的Excel工作簿
  • 转到它的VBA项目(Alt-F11)
  • 添加一个新的代码模块
  • 粘贴下面的代码
  • 调整第一行的path,使其指向上面创build的文件
  • 运行testing例程

要使用的代码:

 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工作的结论:

  • .Description总是可读的,不pipe怎样(所以不像所有的string属性都是这样的)
  • 仅当禁用macros时,xlsb和xlsm文件才会导致不可读的.HelpFile
  • 在所有情况下(!)xls文件导致不可读的.HelpFile

这可能更奇怪,因为我发誓我曾经看到VBE GUI中popup的questionmarks-version这个项目的属性,虽然我现在无法再现。

我意识到这是一个边缘案例,如果有的话(除了.xls处理),所以它可能只是被微软的质量保证部门忽视,但对于我目前的项目,我必须在Excel中正确和一致地工作版本和工作簿格式…

任何人都可以testing这个以及validation我的Excel安装不被洗净? 最好还与另一个Excel版本,看看是否有所作为?

希望这不会像我的一些其他post在这里:)成为一个风滚草可能“风滚草发电机”可能是一个很好的徽章添加…

UPDATE

我已经扩展了属性列表来testing只是为了看看我还能find什么,以及所有VBProject的属性(BuildFileName,Description,Filename,HelpContextID,HelpFile,Mode,Name,Protection和Type).HelpFile有这个问题当macrosclosures时被破坏。

更新2

将示例代码移植到Word 2010并运行该示例代码的行为完全相同 – 禁用macros时.HelpFile属性格式错误。 似乎负责这个的代码在整个Office范围内,可能在一个共享的VBA库模块中(正如TBH预期的那样)。

更新3

只是在Excel 2007和2003上testing过,并且都包含这个bug。 我没有得到一个Excel XP安装来testing它,但我可以放心地说,这个问题已经有很长的历史了:)

我搞砸了所涉及的string的基本二进制表示,并发现.HelpFilestring属性确实返回一个格式错误的string。

由.HelpFile属性返回的BSTR表示forms(用于VB(A)string的水下二进制表示forms)将在string前面的4个字节中列出string大小,但下面的内容是用ASCII表示forms填充的,而不是Unicode(UTF16 )表示为VBA期望。

parsing返回的BSTR的内容并自行决定哪种格式最有可能在某些情况下解决这个问题。 另一个问题不幸的是在这里玩:它只适用于长度为偶数的string…奇数长度的string得到他们的最后一个字符砍掉,他们的BSTR大小报告一短,而ASCII表示不包括最后一个字符…在这种情况下,string不能完全恢复。

以下代码是此修补程序增强的问题中的示例代码。 对于原始示例代码,也适用相同的使用说明。 RecoverString函数执行所需的魔术,以恢复string;)DumpMem返回传递给它的string的50字节内存转储; 使用这个来看看内存如何精确地放置在传入的string中。

 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