VBA directory search for files stored in mac time capsule & in subfolders

[thebute]

Hi All,

I have recently recieved some help on putting together a macro that searches for files (with "worksheet" in its name) in two speciphicly specified directories. The macro works great on a windows platform.
The challenge Im facing now is to have the maco do the same on our Mac machine.
additionaly Im also looking for help on having te macro search in subfolders specified in the two directoris.

The two directores that the macro should search through are as follow:
1: /Volumes/Time Capsule van Bute/ButeBV/dossiers 2014/Dossiers VP
2: /Volumes/Time Capsule van Bute/ButeBV/dossiers 2014/Afgeronde dossiers/afgeronde dossiers VP

this is the macro mentioned: its stored in module MasterFile:

the file: https://drive.google.com/file/d/0B06UUoORgT0VZ2NvQmRFTDJ5aXM/edit?usp=sharing

thanks for your help in advance
thebute


the macro:

Dim vFiles As Variant


Sub DossierNummer()
  Dim RimorMacro As String
  Dim mysht As String

  Application.ScreenUpdating = False

  RimorMacro = ActiveWorkbook.Name
  Sheets("OverzichtInhoud").Select
  Range("A2:Q2" & ActiveSheet.UsedRange.Rows.Count).ClearContents
  Range("A2").Select


  Sheets("StartPunt").Select


  get_filename
  Sheets("StartPunt").Select
  lrow = Range("E1", Selection.End(xlDown)).Count
 
  For i = 2 To lrow
    If Range("E" & i).Value = "" Then
      MsgBox "Gegevens staan nu klaar in de OverzichtInhoud!", vbInformation, "Status Kopiëren"
      Exit Sub
    Else
      Workbooks.Open Filename:=vFiles(1, i) & vFiles(2, i)
  
      mysht = ActiveWorkbook.Name
        Application.StatusBar = "De Tool is bezig met het verwerken van: " & mysht
            
            Sheets("Worksheet").Select
                Range("B4:B10,B29,B20,B24,B30,B31,B32,B33,B34,B35,B36").Select
                    Selection.Copy
                
      Workbooks(RimorMacro).Activate
      Sheets("OverzichtInhoud").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
  
      ActiveCell.Offset(0, 0).Select
        Workbooks("" & mysht & "").Activate
            Range("B24").Select
 
ActiveCell.Offset(0, 0).Select
    Workbooks("" & mysht & "").Activate
        Range("B24").Select
 
Selection.End(xlDown).Select
Selection.Copy
Workbooks("" & RimorMacro & "").Activate
Selection.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(1, 0).Select
Application.CutCopyMode = False
Sheets("StartPunt").Select
      
      Workbooks(mysht).Close SaveChanges:=False
      Workbooks(RimorMacro).Activate
    End If
  Next i
  Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub





Sub get_filename()
  Const sPathRange As String = "C3,C7"
  Const iIncr As Long = 50

  Dim fdr As String
  
  ' this range will store your paths
  Dim rngPathList As Excel.Range
  Dim rng As Excel.Range
  
  Dim iSize As Long

  iSize = iIncr
  
  mrow = 2
  
  ReDim vFiles(1 To 2, 2 To iSize)
  
  Set rngPathList = Range(sPathRange)
  
  Range(Range("E2"), Range("E2").End(xlDown)).ClearContents
  Range("E2").Select
  
  For Each rng In rngPathList
    spath = rng.Value
    fdr = Dir(spath & "\*Worksheet*.xlsm")
    
    Do While fdr <> ""
      If mrow > iSize Then
        iSize = iSize + iIncr
        ReDim Preserve vFiles(1 To 2, 2 To iSize)
      End If

      vFiles(1, mrow) = spath & Application.PathSeparator
      vFiles(2, mrow) = fdr
      
      Cells(mrow, 5).Value = fdr
      
      fdr = Dir
      mrow = mrow + 1
    Loop
    
    If iSize >= mrow Then
      iSize = mrow - 1
      ReDim Preserve vFiles(1 To 2, 2 To iSize)
    End If
  Next rng
End Sub