Consulting

Results 1 to 2 of 2

Thread: Pulling data from multiple Word docs in multiple folders to Excel

  1. #1

    Post 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.

    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

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •