Excel Forum

Help converting Macro to be compatible with Mac

Vincent Mackey

New Member

Members

Forum Posts: 1

Member Since:
October 16, 2019

Offline

October 16, 2019 - 4:34 am

Hello! I have a client that is using Macs to run the macro below and I am having trouble converting it. File is attached as well! Any solutions?

Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook

    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

    If (vbBoolean <> VarType(fnameList)) Then

        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0

            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

            Set wbkCurBook = ActiveWorkbook

            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1

                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)

                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next

                wbkSrcBook.Close SaveChanges:=False

            Next

            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If

    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub

Catalin Bombea

Iasi, Romania

Admin

Forum Posts: 1844

Member Since:
November 8, 2013

Offline

October 18, 2019 - 8:44 pm

Not easy.

I use different codes on windows, for mac there can be at least 2 separate cases.

The code is limiting the number of selected files to exactly 2, you will have to adjust this.

Sub ImportNewData()
Dim ArrFiles As Variant, Fname As Variant, i As Byte, ExitPoint As Label

#If Mac Then
If Val(Application.Version) >= 15 Then
'excel 2016 for Mac, use posix to get files
ArrFiles = GetMac2016Files
Else
'earlier versions of excel for Mac
ArrFiles = GetMacFiles
End If
#Else
'Windows
ArrFiles = GetWinCSVFiles
#End If

'TypeName returns Variant()in Win, just V() on Mac 2011, S() in Mac 2016. If the user cancelled the import, Win will return Boolean, Mac+Excel 2016 will return Empty...
If Not TypeName(ArrFiles) Like "*()*" Then GoTo ExitPoint

'loop through list of files:

For i = LBound(ArrFiles) To UBound(ArrFiles)
GetDataFromCSVFiles CStr(ArrFiles(i)) 'replace this with your function to process files
Next

end sub

Here are the codes I use to get files:

Function GetMac2016Files() As Variant
Dim Files As Variant
'Ron de Bruin, 20 March 2016
Dim MyPath As String, MyScript As String, MyFiles As String, FileFormat As String

GetMac2016Files = False

On Error Resume Next
MyPath = MacScript("return (path to desktop folder) as String")
FileFormat = "{""public.comma-separated-values-text""}"

MyScript = "set theFiles to (choose file of type" & _
" " & FileFormat & " " & _
"with prompt ""Please select both csv files, for Inquiries and Subscribers!"" default location alias """ & _
MyPath & """ with multiple selections allowed)" & vbNewLine & _
"set thePOSIXFiles to {}" & vbNewLine & _
"repeat with aFile in theFiles" & vbNewLine & _
"set end of thePOSIXFiles to POSIX path of aFile" & vbNewLine & _
"end repeat" & vbNewLine & _
"set {TID, text item delimiters} to {text item delimiters, ASCII character 10}" & vbNewLine & _
"set thePOSIXFiles to thePOSIXFiles as text" & vbNewLine & _
"set text item delimiters to TID" & vbNewLine & _
"return thePOSIXFiles"

MyFiles = MacScript(MyScript)
On Error GoTo 0
If MyFiles <> "" Then
Files = Split(MyFiles, Chr(10))
If UBound(Files) <> 1 Then
MsgBox "Please select 2 csv files, one for Inquiries and one for Subscribers!"
Files = False 'accept only 2 files
End If
End If
GetMac2016Files = Files
End Function
Function GetMacFiles() As Variant
Dim Files As Variant
'Ron de Bruin, 20 March 2016
Dim MyPath As String, MyScript As String, MyFiles As String, FileFormat As String

GetMacFiles = False

On Error Resume Next
MyPath = MacScript("return (path to desktop folder) as String")
FileFormat = "{""public.text""}"

MyScript = "set applescript's text item delimiters to {ASCII character 10} " & vbNewLine & _
"set theFiles to (choose file of type" & _
" " & FileFormat & " " & _
"with prompt ""Please select both csv files, for Inquiries and Subscribers!"" default location alias """ & _
MyPath & """ with multiple selections allowed) as string" & vbNewLine & _
"set applescript's text item delimiters to """" " & vbNewLine & _
"return theFiles"

MyFiles = MacScript(MyScript)
On Error GoTo 0

If MyFiles <> "" Then
Files = Split(MyFiles, Chr(10))
If UBound(Files) <> 1 Then
MsgBox "Please select 2 csv files, one for Inquiries and one for Subscribers!"
Files = False 'accept only 2 files
End If
'check if both are csv (if no filter applied)

End If
GetMacFiles = Files
End Function
Function GetWinCSVFiles() As Variant
Dim Files As Variant
GetWinCSVFiles = False
#If Not Mac Then
With Application.FileDialog(3)
.AllowMultiSelect = True
.Title = "Please select both csv files, for Inquiries and Subscribers!"
.Filters.Add "CSV Files", "*.csv"
If .Show = True Then
'accept 2 files only
If .SelectedItems.Count <> 2 Then MsgBox "Please select 2 csv files, one for Inquiries and one for Subscribers!": Exit Function
Files = Array(.SelectedItems(1), .SelectedItems(2))
Else
Files = False
End If
End With
#End If
GetWinCSVFiles = Files
End Function