Vfrdtyky

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!

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.

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.