''' If OS is Mac it comes here
    Call Select_File_Or_Files_Mac
Else
''''' If OS is PC it comes here ''''
    Call Gather_Data

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

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

Dim MyFiles As String
Sub Get_Os()
Dim info As System
Dim myos
    myos = Application.System.OperatingSystem
    If myos = "Macintosh" Then
    ''' system is Mac ''
        Call GetTextFilesOnMac
    Else
    ''' system is PC
        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 GetTextFilesOnMac()
Dim vFileName As Variant
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
    'Call the function to return the files
   vFileName = Select_File_Or_Files_Mac

    'If it's empty then the user cancelled
    'If IsEmpty(vFileName) Then Exit Sub
    Documents.Open fileName:=MyFiles, ConfirmConversions:=False, _
         ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto
        '''''''''''''''''''''
    wdDoc = ActiveDocument
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

Function Select_File_Or_Files_Mac() As Variant
    'Uses AppleScript to select files on a Mac
    Dim MyPath As String, MyScript As String, MySplit As Variant

    'Get the documents folder as a default
    On Error Resume Next
    MyPath = MacScript("return (path to documents folder) as String")

    'Set up the Apple Script to look for text files
    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"

    'Run the Apple Script
    MyFiles = MacScript(MyScript)
    On Error GoTo 0

End Function