VBA - Office 365 x64 bit - Completely crashing - vba

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.