Loop through all .xls files in subdirectories of a directory

[jackbergersen]

Hello All,

I am having a bit of trouble with a bit of code. I have a bunch of code that I want to run on all excel files that live one level down from my main directory.

I have a general directory (orders) which contains a variable amount of subfolders each month (in picture below, 'Dan', 'Frank', 'Steve'), and I would like to look through all the excel files in 'Dan', 'Frank', 'Steve', but not in the main directory (orders), or any subdirectories within 'Dan', 'Frank', 'Steve'.

I am able to loop through all the excel files in the subdirectories individually if I hardcode the directory names, but as they are variable, I would like to make my code accomodating.... Any thoughts? Thanks all!



~ Jack

 

[Salahbj89]

Hello everyone,

I am very beginner in coding and trying to write a code with the same spirit of this thread but looping through Word files instead of looping through excel files. Briefly, I am trying to write a code that search the latest modified Word files, inside a folder and every subfolders, in order to open them, Copy the second table in each word documents and importe it to an excel worksheet (as well as the Word document name). What I (almost) achieved is only finding the latest modified word document in a specific path extract its name and the second table (but needs also to be improved more). I should add some lines to make the code loop through word documents on the subfolders of the path as well. My code is as below. Thanks for any comment or advise that you could give me.

Sub GetTablesFromWord()

  
  Dim wApp As Word.Application
  Dim wDoc As Word.Document
  Dim wTable As Word.Table
  Dim wCell As Word.Cell
  Dim basicPath As String
  Dim fName As String
   
   
  Dim myWS As Worksheet
  Dim xlCell As Range
  Dim lastRow As Long
  Dim rCount As Long
  Dim cCount As Long
  Dim RLC As Long
  Dim CLC As Long
  Dim fileModDate As String
  
  Dim strFolder  As String
  Dim strFile    As String
  Dim latestFile As String
  Dim dtLast     As Date


  
  
'---Construct drawings directory
  Const DWG_PATH As String = "\\Diskstation\hmd\02. Drawing Approval\"
  
'---Attribute a name to the excel sheet (DWG APPROVAL COMMENTS)
  Set myWS = ThisWorkbook.Worksheets("DWG APPROVAL COMMENTS")
  
'---"open" Word
  Set wApp = CreateObject("Word.Application")


'---Get Last Modified .doc file name in the directory


  fName = Dir(DWG_PATH & "\*.doc*")
  Do While fName <> ""
  If FileDateTime(DWG_PATH & fName) > dtLast Then
            dtLast = FileDateTime(DWG_PATH & fName)
            latestFile = DWG_PATH & fName
   End If
   fName = Dir




'---This puts the filename into column A to help separate the DWG doc files in Excel
    myWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = _
     "DWG name  :  " & fName & ""
     myWS.Range("A" & Rows.Count).Select
    Selection.Font.Bold = True
    
'---Open the Word file
    wApp.Documents.Open DWG_PATH & fName
    Set wDoc = wApp.Documents(1)
    
'---Skip the ISHIMA heading table and work with comments table (2)
    If wDoc.Tables.Count > 0 Then
      Set wTable = wDoc.Tables(2)
      rCount = wTable.Rows.Count
      cCount = wTable.Columns.Count
     
      For RLC = 2 To rCount
        lastRow = myWS.Range("A" & Rows.Count).End(xlUp).Row + 1
        For CLC = 1 To cCount


'---If there are merged cells in the Word table, an error will begenerated - ignore the error,
'but also won't process the data
          On Error Resume Next
          Set wCell = wTable.Cell(RLC, CLC)
          If Err <> 0 Then
            Err.Clear
          Else
            If CLC = 2 Then
              Set xlCell = myWS.Range("A" & lastRow)
              xlCell = wCell
            End If
            If CLC = 4 Then
              Set xlCell = myWS.Range("B" & lastRow)
              xlCell = wCell
            End If
            If CLC = 6 Then
              Set xlCell = myWS.Range("C" & lastRow)
              xlCell = wCell
            End If
          End If
          On Error GoTo 0
        Next
      Next
      Set wCell = Nothing
      Set wTable = Nothing
      
      
    End If ' end of wDoc.Tables.Count test
    wDoc.Close False
    Set wDoc = Nothing


  fName = Dir() ' gets next .doc* filename in the folder
  Loop
  wApp.Quit
  Set wApp = Nothing
  
  
  MsgBox "Finish..."
End Sub

 

[John_w]

Hello everyone,

I am very beginner in coding and trying to write a code with the same spirit of this thread but looping through Word files instead of looping through excel files. Briefly, I am trying to write a code that search the latest modified Word files, inside a folder and every subfolders, in order to open them, Copy the second table in each word documents and importe it to an excel worksheet (as well as the Word document name). What I (almost) achieved is only finding the latest modified word document in a specific path extract its name and the second table (but needs also to be improved more). I should add some lines to make the code loop through word documents on the subfolders of the path as well. My code is as below. Thanks for any comment or advise that you could give me.

Replying to your PM here since your Inbox is full.

Firstly, I would start a new thread since your request is very different to this thread.

It's not clear if you want to find the single latest modified Word file in a folder and all its subfolders, or the latest Word files in the folder and each subfolder. Either way, use a recursive FileSystemObject procedure (as shown in my code in this thread) instead of a VBA Dir function loop, which your code uses. The DateLastModified property of the FSO File object contains a file's modified date/time.

Hope that helps you to make progress.

 

[hansgrandia]

Hello,
Would it also be possible to select a folder from John his code? Thank you!
Hans

 

[John_w]

Hello,
Would it also be possible to select a folder from John his code? Thank you!
Hans

Replace:

Process_XLS_Files Fso, "C:\Orders"

with:

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder"
        .Show
        If .SelectedItems.Count <> 0 Then
            Process_XLS_Files Fso, .SelectedItems(1)
        End If
    End With

 

[hansgrandia]

Thank you John. I'm now trying to open the workbooks instead of using Debug.Print. Below standing code doesn't seem to work. Could you please support?

If InStr(File.Name, ".xls*") Then
                'Debug.Print File.Path
                wb = Workbooks.Open(File.Name, ".xls*")
            End If

Regards,
hans

 

[John_w]

As indicated by the comment in the original code, use File.Path:

Set wb = Workbooks.Open(File.Path)

to close the opened workbook:

wb.Close SaveChanges:=False  'or True

 

[hansgrandia]

Thank you John! Works perfect.