copying data from excel files in folder/subfolders

Hi Guy

im trying to get this macro to copy data from excel files in folders it works but i need it to get data from excel files in sub-folders aswell can someone please help

Thanks

Sub Button18_Click()

    Dim StrFileName As String
    Dim FileLocnStr As String
    Dim fNum As Long
    Dim StrFile As String

    FileLocnStr = InputBox("Please enter your Job number here", "Digital Preflight", "p:/") 'ThisWorkbook.Path

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    fNum = 1
    StrFile = Dir(FileLocnStr & "\*.xls")

    Do While Len(StrFile) > 0
        CopyData FileLocnStr & "\" & StrFile, fNum
        StrFile = Dir
        fNum = fNum + 1
    Loop

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With


End Sub


Sub CopyData(StrFileName As String, fNum As Long)
    Dim Wb1 As Workbook, rngCopy As Range
    Dim rngDest As Range

    Set Wb1 = Workbooks.Open(StrFileName)
    Set rngCopy = Wb1.Sheets("Items").Range("A1:aq617")
    Set rngDest = ThisWorkbook.Sheets("Paste") _
                        .Range("a1")

    rngCopy.Copy rngDest
    With rngDest.Resize(rngCopy.Rows.Count, rngCopy.Columns.Count)
        .Value = .Value
    End With

    Wb1.Close False

End Sub