Hello everyone!
I have some codes that is working fine on Windows OS, but someone wants to run it on MAC OS but it didn't run. If anyone knows how to fix the codes for me please do because I need to fix it urgently. I will paste the codes below. Thank you in advance.
Code:
Sub WINorMAC()
' Test for the operating system.
If Not Application.OperatingSystem Like "*Mac*" Then
' Is Windows.
Call ImportWordTable
Else
' Is a Mac and will test if running Excel 2011 or higher.
If Val(Application.Version) > 14 Then
Call ImportWordTable
End If
End If
End Sub
'Sub Get_Os()
'Dim TheOS As String
'TheOS = Application.OperatingSystem ''' this line checks for the Operating system
'If Left(TheOS, 7) <> "Windows" Then
''' If OS is Mac it comes here
'Call Select_File_Or_Files_Mac
'Else
''''' If OS is PC it comes here ''''
'Call ImportWordTable
'End If
'End Sub
Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim wordRow As Long 'row index in Word
Dim wordCol As Integer 'column index in Word
Dim ExcelRow As Long 'row index in Excel
Dim ExcelCol As Integer 'column index in Excel
Dim ColToStart As Integer
wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
If wdDoc.tables.Count = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
Else
ExcelRow = 0
Sheets.Add after:=Sheets(Worksheets.Count)
ColToStart = 1
For TableNo = 1 To wdDoc.tables.Count
With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
If TableNo > 1 Then
ColToStart = 2
End If
For wordCol = ColToStart To .Columns.Count
ExcelCol = ExcelCol + 1
For ExcelRow = 1 To .Rows.Count
On Error Resume Next
ActiveSheet.Cells(ExcelCol, ExcelRow) = WorksheetFunction.Clean(.cell(ExcelRow, wordCol).Range.Text)
On Error GoTo 0
Next ExcelRow
Next wordCol
End With
Next TableNo
End If
End With
Set wdDoc = Nothing
End Sub
Sub Select_File_Or_Files_Mac()
'''''' Code for Mac
Dim MyPath As String
Dim MyScript As String
Dim MyFiles As String
Dim MySplit As Variant
Dim N As Long
Dim Fname As String
Dim mybook As Workbook
'''''''''''''' Variables from PC code '''''
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim s
Dim i As Long
Dim Myrow As Long
Dim Clrow As Long
Dim c As Variant
Dim Mcat As String '' Main Catagory
Dim Scat As String '' Sub Catagory
Dim Ncat As String
Dim Rws As Worksheet
Dim Cvsws As Worksheet
Dim Pwb As Workbook
Dim Cvwb As Workbook
''''''''''''''''''''
Dim ww As String
ww = ThisWorkbook.Path
On Error Resume Next
MyPath = MacScript("return (path to documents folder) as String")
'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"
' In the following statement, change true to false in the line "multiple
' selections allowed true" if you do not want to be able to select more
' than one file. Additionally, if you want to filter for multiple files, change
' {""com.microsoft.Excel.xls""} to
' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
' if you want to filter on xls and csv files, for example.
MyScript = _
"set applescript's text item delimiters to "","" " & vbNewLine & _
"set theFiles to (choose file of type " & _
" {""org.openxmlformats.wordprocessingml.document""} " & _
"with prompt ""Please select a file or files"" default location alias """ & _
MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
"set applescript's text item delimiters to """" " & vbNewLine & _
"return theFiles"
MyFiles = MacScript(MyScript)
On Error GoTo 0
If MyFiles <> "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
MySplit = Split(MyFiles, ",")
For N = LBound(MySplit) To UBound(MySplit)
' Get the file name only and test to see if it is open.
Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), Application.PathSeparator, , 1))
If bIsBookOpen(Fname) = False Then
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MySplit(N))
On Error GoTo 0
'''''''''''''''''''' ''''''''''''''
MsgBox "Mac code ''''"
'''''''''''''''''''''''''
If Not mybook Is Nothing Then
MsgBox "You open this file : " & MySplit(N) & vbNewLine & _
"And after you press OK it will be closed" & vbNewLine & _
"without saving, replace this line with your own code."
mybook.Close SaveChanges:=False
End If
Else
MsgBox "We skipped this file : " & MySplit(N) & " because it Is already open."
End If
Next N
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Contributed by Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function