VBA - Office 365 x64 bit - Полная ошибка

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

TBH, я понятия не имею, как это работало правильно на 32-битной сборке.Объявления для двух структур неверны.Этот ...

Private Type ShortItemId
  cb                                As Long
  abID                              As Byte
End Type

... определяется в документации MS следующим образом:

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

Обратите внимание, что abID - это массив, а cb - это короткое число без знака (вы можете использовать Integer для этого в VBA, но это определенно не Long).

Кроме того, эта структура (обернутая в ITEMIDLIST ) даже не должна быть выделена вызывающей стороной , но должна быть освобождена вызывающей стороной:

Вызывающее приложение несет ответственность за освобождение возвращенного IDList с помощью CoTaskMemFree.

Re указатели, единственные указатели (которые не являются 'маршалинг от String) - это параметр pidl, равный SHGetSpecialFolderLocation и указатель на ppidl в SHGetPathFromIDList.Обратите внимание, что вы не можете использовать структуру, определенную 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, но это не должно иметь никакого значения.

Answer 2

SHGetSpecialFolderLocation не заполняет память, выделенную для ITEMIDLIST, как обычно делает функция Declare d, она выделяет новый фрагмент памяти, который вам понадобится позже требуется для освобождения с помощью CoTaskMemFree. Это лишает смысла объявлять ITEMIDLIST как структуру в VBA для начала (и ваше объявление в любом случае неверно, cb должно быть Integer, а abID - это байтовый массив переменной длины, а не один байт ).

Если вам нужно что-то сделать с отдельными элементами структуры, расположенными таким образом, вам придется скопировать их из возвращенного указателя с помощью CopyMemory. К счастью, вам не нужно ничего делать, потому что SHGetSpecialFolderLocation возвращает указатель на PIDLIST_ABSOLUTE, а SHGetPathFromIDList принимает 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 ... после того, как обнаружение возвращаемого значения указывает на ошибку.