Question

这是我第一次寻求有关堆栈溢出的帮助，更不用说评论了，所以请对我温柔：）

我不知所措，我会提供尽可能多的信息。

问题

我想作为序言，此代码不会在最新更新的0365（仅在版本1807及更早版本）上导致任何崩溃。它也完全不会在32位版本上崩溃，这使我认为这是64位问题。我的客户也无法从该版本进行更新，因此仅要求他们进行更新就不会发生。

我已将崩溃范围缩小到此特定部分。

Public Function GetSpecialFolder(CSIDL As Long) As String
'*******************************************************************************
'*  Function:     GetSpecialFolder
'*  Purpose:      Wraps the apis to retrieve folders such as My Docs etc.

'*******************************************************************************
      Dim idlstr                   As Long
      Dim sPath                         As String
      Dim IDL                           As ITEMIDLIST
      Const MAX_LENGTH = 260

      'Fill the IDL structure with the specified folder item.
      On Error GoTo GetSpecialFolder_Error

      idlstr = SHGetSpecialFolderLocation _
          (0, CSIDL, IDL)

      If idlstr = 0 Then
        'Get the path from the IDL list, and return the folder adding final "\".
        sPath = Space$(MAX_LENGTH)
        **idlstr = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)**
        If idlstr Then
          GetSpecialFolder = Left$(sPath, InStr(sPath, Chr$(0)) _
              - 1) & "\"
        End If
      End If

    procExit:
      On Error Resume Next
      Exit Function

    GetSpecialFolder_Error:
      CommonErrorHandler lngErrNum:=Err.Number, strErrDesc:=Err.Description, _
        strProc:="GetSpecialFolder", strModule:="modWinAPI", lngLineNum:=Erl
      Resume procExit

    End Function

这是声明

'File system
Public Declare PtrSafe Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long

Public Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare PtrSafe Function GetTempPath Lib "kernel32" _
    Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As LongPtr

Private Type ITEMIDLIST
mkid                              As ShortItemId
End Type

Private Type ShortItemId
  cb                                As Long
  abID                              As Byte
End Type

我已经尝试根据我在网上找到的文档中的建议添加Long Ptr ，但这没有帮助。

有人可以帮助我吗？

谢谢！

Answer 1

SHGetSpecialFolderLocation不会像ITEMIDLIST d函数那样填充为Declare分配的内存，它会分配一个新的内存，供您以后使用required CoTaskMemFree免费。因此，将ITEMIDLIST声明为VBA中的结构是毫无意义的（无论如何您的声明都是错误的，cb必须为Integer，而abID是一个变量-长度字节数组，而不是单个字节）。

如果您需要对以这种方式分配的结构的各个成员执行某些操作，则必须使用CopyMemory将它们从返回的指针中复制出来。幸运的是，您不需要执行任何操作，因为SHGetSpecialFolderLocation返回了指向PIDLIST_ABSOLUTE和SHGetPathFromIDList accepts PCIDLIST_ABSOLUTE的指针：

Public Declare PtrSafe Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hwndOwner As LongPtr, ByVal nFolder As Long, ByRef pIdl As LongPtr) As Long

Public Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pIdl As LongPtr, ByVal pszPath As String) As Long

Public Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (pv As Any)

Public Function GetSpecialFolder(ByVal CSIDL As Long) As String
  Dim retval As Long
  Dim pIdl As LongPtr
  Dim sPath As String

  Const MAX_LENGTH = 260


  retval = SHGetSpecialFolderLocation(0, CSIDL, pIdl)

  If retval = 0 Then
    sPath = Space$(MAX_LENGTH)
    retval = SHGetPathFromIDList(pIdl, sPath)

    If retval <> 0 Then
      GetSpecialFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1) & "\"
    End If

    CoTaskMemFree ByVal pIdl
  End If

End Function

请注意，在此类函数中使用On Error Goto是毫无意义的，因为Windows API通常不会引发异常，它们会返回错误代码。如果您在发现返回值表示错误之后使用Err.Raise ...，将有意义。

Answer 2

TBH，我不知道它在32位版本上是如何正常工作的。这两个结构的声明不正确。这个...

Private Type ShortItemId
  cb                                As Long
  abID                              As Byte
End Type

...在the MS documentation中的定义如下：

typedef struct _SHITEMID {
  USHORT cb;
  BYTE   abID[1];
} SHITEMID;

请注意，abID是一个数组，而cb是一个无符号的short（您可以在VBA中使用Integer，但绝对不是Long ）。

此外，此结构（包装在ITEMIDLIST中） 甚至不应该由调用方分配 ，但必须释放（呼叫者）：

调用应用程序负责通过使用CoTaskMemFree释放返回的IDList。

关于指针，唯一的指针（未从String中编组）是 SHGetSpecialFolderLocation的pidl参数和SHGetPathFromIDList中指向ppidl的指针。请注意，您不能使用VBA定义的结构，因为完成后需要释放内存。这样的事情会起作用：

Private Declare PtrSafe Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As LongPtr) As Long

Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean

Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As LongPtr)

Private Const S_OK As Long = 0
Private Const MAX_LENGTH = 260

Public Function GetSpecialFolder(ByVal CSIDL As Integer) As String
    Dim result As Long
    Dim path As String
    Dim idl_ptr As LongPtr

    'Fill the IDL structure with the specified folder item.
    result = SHGetSpecialFolderLocation(0, CSIDL, idl_ptr)

    If result = S_OK Then
        'Get the path from the IDL list, and return the folder adding final "\".
        path = Space$(MAX_LENGTH)
        If SHGetPathFromIDList(idl_ptr, path) Then
            GetSpecialFolder = Left$(path, InStr(path, vbNullChar) - 1) & "\"
        End If
        CoTaskMemFree idl_ptr
    End If
End Function

请注意，根据评论中的讨论，从技术上讲，您也可以将hwndOwner声明为LongPtr，但这没有任何区别。

VBA-Office 365 x64位-完全崩溃

2 个答案: