Need 64 bit Compile Check Please

Looking for someone with Office 64 bit installed who would check the following code for compile error. Thank you.

Code:

---

Option Explicit
#If Win64 Then
Public Declare PtrSafe Function SHGetSpecialFolderLocation _
                        Lib "shell32" (ByVal hwnd As LongPtr, _
                                        ByVal nFolder As Long, ppidl As ITEMIDLIST) As LongPtr
Public Declare PtrSafe Function SHGetPathFromIDList _
                        Lib "shell32" Alias "SHGetPathFromIDListA" _
                            (ByVal pidl As LongPtr, ByVal pszPath As String) As Long
Public Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
#Else
Public Declare Function SHGetSpecialFolderLocation _
                        Lib "shell32" (ByVal hwnd As Long, _
                                        ByVal nFolder As Long, ppidl As Long) As Long
Public Declare Function SHGetPathFromIDList _
                        Lib "shell32" Alias "SHGetPathFromIDListA" _
                            (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
#End If

Private Type ****EMID
  cb As Long
  abID As Byte
End Type

Private Type ITEMIDLIST
  mkid As ****EMID
End Type

Public Const CSIDL_WINDOWS = &H24
Public Const CSIDL_MYPICTURES = &H27
Public Const CSIDL_PERSONAL = &H5
Public Const MAX_PATH = 260
Public Const NOERROR = 0

Public Function SpecFolder(ByVal lngFolder As Long) As String
Dim lngPidlFound As Long
Dim lngFolderFound As Long
Dim lngPidl As Long
Dim strPath As String

  strPath = Space(MAX_PATH)
  lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)

  If lngPidlFound = NOERROR Then
      lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
      If lngFolderFound Then
          SpecFolder = Left$(strPath, InStr(1, strPath, vbNullChar) - 1)
      End If
  End If

  CoTaskMemFree lngPidl
lbl_Exit:
  Exit Function
End Function

Sub Test()
 MsgBox SpecFolder(CSIDL_WINDOWS)
End Sub

---

Sam,

I noticed that you edited this post. What is the purpose of ****EMID? That certainly doesn't compile :-(. Where you able to check if it compiled in Word 64 bit?

I just added White space, ****EMID was already there.

What should it be? If you cant edit it, I will.

I'm strictly 32 bit, sorry.



I sure miss the old Formatting code blocks with auto indent.

It was SierraHotelIndiaTango or S*H*I*TEMID the source was: http://www.jkp-ads.com/articles/apideclarations.asp

Still hoping someone can test this code and see if it will work in Office 64 bit:

Code:

---

Option Explicit
#If VBA7 Then
Public Declare PtrSafe Function SHGetSpecialFolderLocation _
                        Lib "shell32" (ByVal hwnd As LongPtr, _
                                        ByVal nFolder As Long, ppidl As LongPtr) As LongPtr
Public Declare PtrSafe Function SHGetPathFromIDList _
                        Lib "shell32" Alias "SHGetPathFromIDListA" _
                            (ByVal pidl As LongPtr, ByVal pszPath As String) As LongPtr
Public Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As LongPtr)
#Else
'Public Declare Function SHGetSpecialFolderLocation _
'                        Lib "shell32" (ByVal hwnd As Long, _
'                                        ByVal nFolder As Long, ppidl As Long) As Long
'
'Public Declare Function SHGetPathFromIDList _
'                        Lib "shell32" Alias "SHGetPathFromIDListA" _
'                            (ByVal pidl As Long, ByVal pszPath As String) As Long
'
'Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
#End If
Public Const CSIDL_WINDOWS = &H24
Public Const CSIDL_MYPICTURES = &H27
Public Const CSIDL_PERSONAL = &H5
Public Const MAX_PATH = 260
Public Const NOERROR = 0
Sub ***Test()
  MsgBox SpecFolder(CSIDL_WINDOWS)
End Sub
Public Function SpecFolder(ByVal lngFolder As Long) As String
#If Win64 Or VBA7 Then
  Dim lngPidlFound As LongPtr
  Dim lngFolderFound As LongPtr
  Dim lngPidl As LongPtr
#Else
'  Dim lngPidlFound As Long
'  Dim lngFolderFound As Long
'  Dim lngPidl As Long
#End If
Dim strPath As String
  strPath = Space(MAX_PATH)
  lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)
  If lngPidlFound = NOERROR Then
      lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
      If lngFolderFound Then
          SpecFolder = Left$(strPath, InStr(1, strPath, vbNullChar) - 1)
      End If
  End If
  CoTaskMemFree lngPidl
lbl_Exit:
  Exit Function
End Function

---

Now you have Sub ***Test

Sierra Hotel India Tango and Foxtrot Uncle Charley Kilo are both verboten. There may be others, but I can't think of any more "Bad" words this early.

From a third source, this is confirmed working:

Code:

---

Option Explicit
#If VBA7 Then
Public Declare PtrSafe Function SHGetSpecialFolderLocation _
                        Lib "shell32" (ByVal hwnd As LongPtr, _
                                        ByVal nFolder As Long, ppidl As LongPtr) As LongPtr
Public Declare PtrSafe Function SHGetPathFromIDList _
                        Lib "shell32" Alias "SHGetPathFromIDListA" _
                            (ByVal pidl As LongPtr, ByVal pszPath As String) As LongPtr
Public Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As LongPtr)
#Else
Public Declare Function SHGetSpecialFolderLocation _
                        Lib "shell32" (ByVal hwnd As Long, _
                                        ByVal nFolder As Long, ppidl As Long) As Long
Public Declare Function SHGetPathFromIDList _
                        Lib "shell32" Alias "SHGetPathFromIDListA" _
() '                            (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
#End If
Public Const CSIDL_WINDOWS = &H24
Public Const CSIDL_MYPICTURES = &H27
Public Const CSIDL_PERSONAL = &H5
Public Const MAX_PATH = 260
Public Const NOERROR = 0
Sub Test()
  MsgBox SpecFolder(CSIDL_WINDOWS)
End Sub
Public Function SpecFolder(ByVal lngFolder As Long) As String
#If Win64 Or VBA7 Then
  Dim lngPidlFound As LongPtr
  Dim lngFolderFound As LongPtr
  Dim lngPidl As LongPtr
#Else
  Dim lngPidlFound As Long
  Dim lngFolderFound As Long
  Dim lngPidl As Long
#End If
Dim strPath As String
  strPath = Space(MAX_PATH)
  lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)
  If lngPidlFound = NOERROR Then
      lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
      If lngFolderFound Then
          SpecFolder = Left$(strPath, InStr(1, strPath, vbNullChar) - 1)
      End If
  End If
  CoTaskMemFree lngPidl
lbl_Exit:
  Exit Function
End Function

---

I'm glad you got it checked.

It's been confirmed that the system uses auto-censor, and complaints have been made in the Moderator's folder about it.