32 bit declarations

[vicedo]

Hi guys,

Please i have a code written for 32 bit API declaration. Anyone who can help me with updating it to 64 bit API declaration?

Thanks in advance

Option ExplicitPublic strPath As String
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
'32-bit API declarations
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
Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer
    '   Root folder = Desktop
    bInfo.pidlRoot = 0&
    '   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
    '   Type of directory to return
    bInfo.ulFlags = &H1
    '   Display the dialog
    x = SHBrowseForFolder(bInfo)
    '   Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function
'Description: Combines all files in a folder to a master file.
Sub MergeFiles()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer
 
    RowofCopySheet = 2 ' Row to start on in the sheets you are copying from
 
    ThisWB = ActiveWorkbook.Name
 
    path = GetDirectory("Select a folder containing Excel files you want to merge")
 
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
            Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
            Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
            CopyRng.Copy Dest
            Wkb.Close False
        End If
 
        Filename = Dir()
    Loop
 
    Range("A1").Select
 
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 
    MsgBox "Done!"
End Sub

 

[RickXL]

Hi,

I think the following should work. However, I noticed that SHBrowseForFolder is not recommended after Windows Vista. https://msdn.microsoft.com/en-us/library/windows/desktop/bb762115(v=vs.85).aspx

Could it be replaced with:

Application.GetOpenFilename

Option Explicit
Public strPath As String
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
#Else
    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
#End If

The above code should work with both 32 and 64 bit versions as the appropriate version will be selected automatically based on the values of VBA2 and Win64 which are set automatically.

 

[vicedo]

Whenever i try to run the code, excel closes. Please can you help me fix this?

 

[RoryA]

hOwner needs to be a LongPtr

 

[vicedo]

The code was originally written by someone else and since i am just a newbie to VBA coding, i am finding it hard to make the adjustments. Please can you help me with the modification?

 

[vicedo]

Thanks a lot people. It worked well