none
update vba code to 64 bit from 32 bit RRS feed

  • Question

  • Good morning all.

    I've brought in an older set of vba code, with my personal.xlsb file to a 64 bit machine. Yes, I've been running an older machine for several years now, but my office machine is 64 bit.

    I got the error which says I need to change it to work on the new machine. I did some looking into this, and found a few articles, but none match what mine is based on--- or perhaps I should say that I'm not seeing it.

    https://social.msdn.microsoft.com/Forums/sharepoint/en-US/35e1ce8c-c3ea-4f35-9709-2bd2fb3df698/code-needs-updating-to-64bit-system?forum=exceldev

    I did download the file referenced in here, but because mine is a function, and not a basic macro, I'm not clear on what to change.

    Declare Function SHGetPathFromIDList Lib "shell32.dll" _
      Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    
    Declare Function SHBrowseForFolder Lib "shell32.dll" _
      Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

    Would someone please help, so that I might resolve this?

    Thank you.

    Monday, November 23, 2015 6:31 PM

Answers

  • Both function are not compatible with 64-bit, especially SHGetPathFromIDList can crash you application, even if you change the declaration to 64-bit!!!

    Here is a replacement for SHGetPathFromIDList:

    Private Function Path2MyDocuments() As String
    '  Const S_OK = 0
    '  Const MAX_PATH = 260
    '  Dim IIDL As ITEMIDLIST
    '  If SHGetSpecialFolderLocation(0, 5, IIDL) = S_OK Then
    '    Path2MyDocuments = Space$(MAX_PATH)
    '    If SHGetPathFromIDList(IIDL.mkID.cb, Path2MyDocuments) Then
    '      Path2MyDocuments = Left$(Path2MyDocuments, InStr(Path2MyDocuments, vbNullChar) - 1)
    '    Else
    '      Path2MyDocuments = ""
    '    End If
    '  End If
      Dim WSHShell As Object
      Set WSHShell = CreateObject("Wscript.Shell")
      Path2MyDocuments = WSHShell.SpecialFolders("MyDocuments")
    End Function

    And use this as replacement for SHBrowseForFolder:

    Option Explicit
    
    'Optionflags des ShellGetFolder-Dialogs
    Enum vbShellGetFolderFlags
      BIF_RETURNONLYFSDIRS = &H1
      BIF_DONTGOBELOWDOMAIN = &H2
      BIF_STATUSTEXT = &H4
      BIF_RETURNFSANCESTORS = &H8
      BIF_EDITBOX = &H10
      BIF_VALIDATE = &H20
      BIF_NEWDIALOGSTYLE = &H40
      BIF_BROWSEINCLUDEURLS = &H80
      BIF_BROWSEFORCOMPUTER = &H1000
      BIF_BROWSEFORPRINTER = &H2000
      BIF_BROWSEINCLUDEFILES = &H4000
      BIF_SHAREABLE = &H8000
      BIF_SHOWALLOBJECTS = &H8
    End Enum
    
    Const BIF_DefaultOptions = BIF_EDITBOX Or BIF_VALIDATE Or BIF_SHOWALLOBJECTS Or BIF_STATUSTEXT Or BIF_NEWDIALOGSTYLE
    Const BIF_BrowseFolder = BIF_RETURNONLYFSDIRS Or BIF_DefaultOptions
    Private Const CSIDL_PERSONAL = &H5 'Eigene Dateien
    
    Sub Example_ShellGetFolder()
      Debug.Print ShellGetFolder(CSIDL_PERSONAL, "Select a folder", BIF_BrowseFolder)
    End Sub
    
    Function ShellGetFolder( _
        Optional RootPath As Variant = CSIDL_PERSONAL, _
        Optional Caption As String = "", _
        Optional Options As vbShellGetFolderFlags = BIF_DefaultOptions) As String
      'http://msdn.microsoft.com/en-us/library/windows/desktop/bb774065(v=vs.85).aspx
      'RootPath kann ein String oder CSIDL-Konstante sein
      Dim objShell As Object, objBrowse As Object
    
      On Error Resume Next
      Set objShell = CreateObject("Shell.Application")
      'Dialog starten und RootPath zurückgeben
      If IsNumeric(RootPath) Then
        'Anfangspfad als Konstante
        Set objBrowse = objShell.BrowseForFolder(&H0, Caption, Options, CLng(RootPath))
      Else
        'Anfangspfad als String
        Set objBrowse = objShell.BrowseForFolder(&H0, Caption, Options, RootPath & Chr(0))
      End If
      ShellGetFolder = objBrowse.Self.Path
    End Function
    

    Andreas.

    • Marked as answer by SteveDB1 Monday, November 23, 2015 9:40 PM
    Monday, November 23, 2015 7:10 PM

All replies

  • Both function are not compatible with 64-bit, especially SHGetPathFromIDList can crash you application, even if you change the declaration to 64-bit!!!

    Here is a replacement for SHGetPathFromIDList:

    Private Function Path2MyDocuments() As String
    '  Const S_OK = 0
    '  Const MAX_PATH = 260
    '  Dim IIDL As ITEMIDLIST
    '  If SHGetSpecialFolderLocation(0, 5, IIDL) = S_OK Then
    '    Path2MyDocuments = Space$(MAX_PATH)
    '    If SHGetPathFromIDList(IIDL.mkID.cb, Path2MyDocuments) Then
    '      Path2MyDocuments = Left$(Path2MyDocuments, InStr(Path2MyDocuments, vbNullChar) - 1)
    '    Else
    '      Path2MyDocuments = ""
    '    End If
    '  End If
      Dim WSHShell As Object
      Set WSHShell = CreateObject("Wscript.Shell")
      Path2MyDocuments = WSHShell.SpecialFolders("MyDocuments")
    End Function

    And use this as replacement for SHBrowseForFolder:

    Option Explicit
    
    'Optionflags des ShellGetFolder-Dialogs
    Enum vbShellGetFolderFlags
      BIF_RETURNONLYFSDIRS = &H1
      BIF_DONTGOBELOWDOMAIN = &H2
      BIF_STATUSTEXT = &H4
      BIF_RETURNFSANCESTORS = &H8
      BIF_EDITBOX = &H10
      BIF_VALIDATE = &H20
      BIF_NEWDIALOGSTYLE = &H40
      BIF_BROWSEINCLUDEURLS = &H80
      BIF_BROWSEFORCOMPUTER = &H1000
      BIF_BROWSEFORPRINTER = &H2000
      BIF_BROWSEINCLUDEFILES = &H4000
      BIF_SHAREABLE = &H8000
      BIF_SHOWALLOBJECTS = &H8
    End Enum
    
    Const BIF_DefaultOptions = BIF_EDITBOX Or BIF_VALIDATE Or BIF_SHOWALLOBJECTS Or BIF_STATUSTEXT Or BIF_NEWDIALOGSTYLE
    Const BIF_BrowseFolder = BIF_RETURNONLYFSDIRS Or BIF_DefaultOptions
    Private Const CSIDL_PERSONAL = &H5 'Eigene Dateien
    
    Sub Example_ShellGetFolder()
      Debug.Print ShellGetFolder(CSIDL_PERSONAL, "Select a folder", BIF_BrowseFolder)
    End Sub
    
    Function ShellGetFolder( _
        Optional RootPath As Variant = CSIDL_PERSONAL, _
        Optional Caption As String = "", _
        Optional Options As vbShellGetFolderFlags = BIF_DefaultOptions) As String
      'http://msdn.microsoft.com/en-us/library/windows/desktop/bb774065(v=vs.85).aspx
      'RootPath kann ein String oder CSIDL-Konstante sein
      Dim objShell As Object, objBrowse As Object
    
      On Error Resume Next
      Set objShell = CreateObject("Shell.Application")
      'Dialog starten und RootPath zurückgeben
      If IsNumeric(RootPath) Then
        'Anfangspfad als Konstante
        Set objBrowse = objShell.BrowseForFolder(&H0, Caption, Options, CLng(RootPath))
      Else
        'Anfangspfad als String
        Set objBrowse = objShell.BrowseForFolder(&H0, Caption, Options, RootPath & Chr(0))
      End If
      ShellGetFolder = objBrowse.Self.Path
    End Function
    

    Andreas.

    • Marked as answer by SteveDB1 Monday, November 23, 2015 9:40 PM
    Monday, November 23, 2015 7:10 PM
  • Hi Andreas.

    Thank you for your timely response. 

    It appears to work--

    Got everything to work now.

    Thank you.

    Best.

    • Edited by SteveDB1 Monday, November 23, 2015 9:40 PM solved issue
    Monday, November 23, 2015 9:14 PM