Log In
Register
Home
New Member
October 16, 2019
Offline
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
November 8, 2013
Offline
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.
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:
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
1 Guest(s)
