Forum

Help converting Mac...
 
Notifications
Clear all

Help converting Macro to be compatible with Mac

2 Posts
2 Users
0 Reactions
226 Views
(@vmackey)
Posts: 1
New Member
Topic starter
 

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

 
Posted : 16/10/2019 2:34 pm
(@catalinb)
Posts: 1937
Member Admin
 

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

 
Posted : 19/10/2019 6:44 am
Share: