Pulling data from multiple Word docs in multiple folders to Excel
I have the code below that works very well if all my Word forms are in the same folder. Unfortunately, my users store them in folders divided up by year and then sub folders for each week. This is the first VBA I have worked with and I haven't been able to figure out if what I want is even possible.
Code:
Sub getCalibrationFormDataNew()
Dim wdApp As New Word.Application
Dim myDoc As Word.Document
Dim CCtl As Word.ContentControl
Dim myFolder As String, strFile As String
Dim myWkSht As Worksheet, i As Long, j As Long
myFolder = "C:\Users\MYNAME\Desktop\Calibrationfolder"
Application.ScreenUpdating = False
If myFolder = "" Then Exit Sub
Set myWkSht = ActiveSheet
ActiveSheet.Cells.Clear
Range("A1") = "Prepared by"
Range("a1").Font.Bold = True
Range("B1") = "Date"
Range("B1").Font.Bold = True
Range("C1") = "Name"
Range("C1").Font.Bold = True
Range("D1") = "P #"
Range("D1").Font.Bold = True
Range("E1") = "Title"
Range("E1").Font.Bold = True
i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(myFolder & "\*.docx", vbNormal)
While strFile <> ""
i = i + 1
Set myDoc = wdApp.Documents.Open(FileName:=myFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With myDoc
j = 0
For Each CCtl In .ContentControls
j = j + 1
myWkSht.Cells(i, j) = CCtl.Range.Text
Next
myWkSht.Columns.AutoFit
End With
myDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Set myDoc = Nothing: Set wdApp = Nothing: Set myWkSht = Nothing
Application.ScreenUpdating = True
End Sub
