View Single Post
 
Old 01-25-2015, 06:49 AM
Story11 Story11 is offline Windows 7 64bit Office 2013
Novice
 
Join Date: Jan 2015
Posts: 28
Story11 is on a distinguished road
Default Help Make My Windows VBA Codes Work on MAC OS

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

Last edited by Story11; 01-25-2015 at 08:54 AM.
Reply With Quote