Need 64 bit Compile Check Please

[gmaxey]

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


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

[gmaxey]

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?

[SamT]

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.

[gmaxey]

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:


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

[SamT]

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.

[gmaxey]

From a third source, this is confirmed working:


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

[SamT]

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.