Consulting

Results 1 to 7 of 7

Thread: Need 64 bit Compile Check Please

  1. #1
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    2,796
    Location

    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.

    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
    Last edited by SamT; 05-03-2018 at 11:50 AM.
    Greg

    Visit my website: http://gregmaxey.com

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    2,796
    Location
    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?
    Greg

    Visit my website: http://gregmaxey.com

  3. #3
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    6,782
    Location
    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.
    Please take the time to read the Forum FAQ

  4. #4
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    2,796
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  5. #5
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    6,782
    Location
    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.
    Please take the time to read the Forum FAQ

  6. #6
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    2,796
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  7. #7
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    6,782
    Location
    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.
    Please take the time to read the Forum FAQ

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •