VBA - Office 365 x64 bit - Completely crashing

Question

This is my first time asking for any help on stack overflow, let alone commenting so please be gentle with me :)

I am at a loss with this one, I will give as much information as possible.

Issue

I would like to preface, this code does not cause any crashes on the latest update of 0365, only on Version 1807 & earlier. It also does not crash on the 32 bit version at all which makes me think it's a 64 bit issue. My client cannot update from this version either so simply asking them to update is not going to be able to happen.

I have narrowed the crashing down to this particular section.

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

And here is the declaration

'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

I have tried adding LongPtr as suggested in documents I've found online but it hasn't helped.

Can anyone help me?

Thanks!

Answer 1

SHGetSpecialFolderLocation does not fill in the memory you allocate for ITEMIDLIST like Declared function usually do, it allocates a new piece of memory that you are later required to free with CoTaskMemFree. That makes it pointless to declare ITEMIDLIST as a structure in VBA to begin with (and your declaration is wrong anyway, cb must be Integer, and abID is a variable-length byte array, not a single byte).

If you needed to do something with individual members of a structure allocated in this way, you would have to copy them out of the returned pointer with CopyMemory. Luckily, you don't need to do any of that because SHGetSpecialFolderLocation returns a pointer to PIDLIST_ABSOLUTE, and 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

Note that it's pointless to have an On Error Goto in such function because Windows API generally do not raise exceptions, they return error codes. It would make sense if you used Err.Raise ... after finding out a return value indicates an error.

Answer 2

TBH, I have no clue how this was functioning correctly on a 32 bit build. The declarations for the two structures are incorrect. This one...

Private Type ShortItemId
  cb                                As Long
  abID                              As Byte
End Type

...is defined in the MS documentation as this:

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

Note that abID is an array, and cb is an unsigned short (you can use an Integer for that in VBA, but it definitely is not a Long).

In addition, this structure (wrapped in the ITEMIDLIST) is not even supposed to be allocated by the caller, but must be freed by the caller:

It is the responsibility of the calling application to free the returned IDList by using CoTaskMemFree.

Re the pointers, the only pointers (that aren't being marshaled from String) are the pidl parameter of SHGetSpecialFolderLocation and the pointer to ppidl in SHGetPathFromIDList. Note that you can't use a VBA defined struct, because you need to free the memory when you're done. Something like this will work:

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

Note that per the discussion in the comments, you could technically declare hwndOwner as LongPtr as well, but it shouldn't make any difference.