Alright. Look at what I did and tell me if it's correct please (you may not really bother the part that opens a Word document since you said you don't deal with Word), simply cross check the syntax and tell me if it's correct, though I ran it om my system, but I'm afraid it might not run on the MAC OS. The codes are below. Thank you.
Code:
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