Creating a Macro to insert information from multiple word files into one single excel

Question

Hi,

My previous question was:

"I have to transfer information from a quite large number of word files into excel. It would be impossible to do it manually and I was wondering if there is a way to help me writing the code in order to create a macro button that will do it for me. The word files contain information such as name, surname, and also there is a simple 4x6 table within them. The files are all structured the same way. I have been thinking of it, as it would recognise the keywords such as "name", and extract the information that the program "sees" next to it, ending up in creating columns named after the keywords and putting the info of every word file into rows. Hope this makes sense."

Now I have created the columns and named them after the variables, how am I going to make the code work and extract the information that "sees" after each variable in the word files and put them into the columns?

Here's the code that I wrote (AI helped me), which doesn't even run, it says something about OLE and then it doesn't function

"Sub ImportDOCX()

Dim FName As String 

Dim FolderPath As String 

Dim wdApp As Object 

Dim wdDoc As Object 

Dim ExcelRow As Long 

Dim ParameterNames As Variant 

Dim Contents As String 

Dim Parameter As Variant 

Dim DataStart As Long 

Dim DataEnd As Long 

' Define the folder path containing Word files 

FolderPath = "H:XXX" 

' Initialize Word application 

Set wdApp = CreateObject("Word.Application") 

wdApp.Visible = False 

' Define the parameter names to search for 

ParameterNames = Array("Variable 1:", "Variable 2:", "Variable 3:", "Variable 4:", \_ 

    "Variable 5:", "Variable 6:") 

ExcelRow = 2 ' Start from row 2 to avoid overwriting headers 

' Find the first file 

FName = Dir(FolderPath & "\\*.docx") 

' While found 

Do While FName <> "" 

    ' Open the Word file 

    Set wdDoc = wdApp.Documents.Open(FolderPath & "\" & FName) 

    Contents = wdDoc.Content.Text 

    ' Loop through parameter names and extract data 

    For Each Parameter In ParameterNames 

        If InStr(Contents, Parameter) > 0 Then 

            DataStart = InStr(Contents, Parameter) + Len(Parameter) 

            DataEnd = InStr(DataStart, Contents, vbNewLine) ' Assumes data ends at the next line 

            ThisWorkbook.Sheets(1).Cells(ExcelRow, Application.Match(Parameter, ThisWorkbook.Sheets(1).Rows(1), 0)).Value = Trim(Mid(Contents, DataStart, DataEnd - DataStart)) 

        End If 

    Next Parameter 

    ' Close the Word file 

    wdDoc.Close 

    ExcelRow = ExcelRow + 1 ' Move to the next row in Excel 

    ' Get the next Word file in the folder 

    FName = Dir 

Loop 

' Clean up Word application 

wdApp.Quit 

End Sub "

I also found a previous comment along with a different code, which helps me instert all the information that's in a word file into a SINGLE CELL! I don;t know how to modify the code to make it work the way I want.

It's super complicated and I don't understand how to work on this. Please if there's anyone who would be able to help.

Thanks,

Mary

@vba @excel @Macro

Answer 1

Hi Mary_120

Greetings!

Thank you for posting in Microsoft Community.

As much as we love to answer your query here right away, it appears that it is beyond our expertise. It is more complex than what we normally discuss here in the community. In order for you to get the accurate information you need, kindly go to Microsoft Q&Aand post your query. They are experts with this kind of concern.

I will leave this thread open for our Excel Experts to join.

Sincerely

Juhn Jac

Microsoft Forum Moderator