Loop through a folder, Copy (first few lines) data from .docx, Paste into individual rows (Excel) 1

[umxir]

Hi, Totally newbie here, please bear with me.

I need to copy a specific data from multiple word documents/files. All files are in a single folder. The contents of the Word Documents are not in a specific format.
No specific marks or anything to distinguish required data from the rest of the content. What I figure out is that, the data I need is in the first few lines (Line 1 to 7).

After copying, the data need to paste into Excel. Each document will have their own row with individual column for each line.

I will be very thankful for your efforts and time.

Thanks

 

[SkipVought]

Hi,

Welcome to Tek-Tips.

What exactly have you done so far to accomplish your task?

Please post any code that you have so far. Explain where you’re have difficulties.

What do you mean by a “line” in MS Word. Word has sentences snd paragraphs. Please post a descriptive sample.

How much experience do you have writing VBA code in Excel?

Please answer each of these questions.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[umxir]

Thanks Skip for your quick reply, Highly Appreciated.

What exactly have you done so far to accomplish your task?
I just found VB Code on the internet, which is almost doing what I required. But that code extract data from Content Controls

Please post any code that you have so far. Explain where you have difficulties.
Code is attached below. Problem I am facing is Dim CCtl As Word.ContentControl, My Files dont have Content Controls.

What do you mean by a “line” in MS Word. Word has sentences snd paragraphs. Please post a descriptive sample.
Line means Enter. User type few words then pressed enter. Again few words, then Enter

How much experience do you have writing VBA code in Excel?
No Experience, But I have a basic understanding of codes so I can understand what means of syntexs, but have NO ability to write one of my own.

Please answer each of these questions.

Sub DateFromDocx()

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


With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Please select a folder"
    .Show
    .AllowMultiSelect = False
       
       If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"
          Exit Sub
       End If
    myFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With


Application.ScreenUpdating = False

If myFolder = “” Then Exit Sub
Set myWkSht = ActiveSheet
ActiveSheet.Cells.Clear

Range(“A1”) = "Name"
Range(“A1”).Font.Bold = True

Range(“B1”) = "Address"
Range(“B1”).Font.Bold = True

Range(“C1”) = “Gender”
Range(“C1”).Font.Bold = True

Range(“D1”) = "Date of Birth"
Range(“D1”).Font.Bold = True

Range(“E1”) = “Email”
Range(“E1”).Font.Bold = True

Range(“F1”) = “Mobile”
Range(“F1”).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

 

[strongm]

>My Files dont have Content Controls.

They generally don't unless the user has manually added any of the various content controls (normally when creating a form)

>Line means Enter

Ok, so paragraphs, in your scenario you mean paragraphs.

So instead of .ContentControls you might want to have a look at .Paragraphs

 

[SkipVought]

Change...

Dim CCtl As Word.ContentControl

...to...

Dim CCtl As Word.[b]Paragraph[/b]

Change...

For Each CCtl In .ContentControls
j = j + 1
myWkSht.Cells(i, j) = CCtl.Range.Text
Next
myWkSht.Columns.AutoFit
End With

...to...

'
            With myDoc
                j = 0
                For Each CCtl In .[b]Paragraphs
[/b]                    j = j + 1
                    myWkSht.Cells(i, j) = CCtl.Range.Text
                    [highlight #FCE94F]If j = 7 Then Exit For[/highlight]
                Next
                myWkSht.Columns.AutoFit
            End With

...adding [highlight #FCE94F]this[/highlight]

ALSO, change these [highlight #E9B96E]SLANTED QUOTES[/highlight] [highlight #E9B96E]“”[/highlight] to [highlight #8AE234]NORMAL QUOTES[/highlight] [highlight #8AE234]""[/highlight] in EVERY usage.

BTW, do you care what document the 7 lines reside in?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[umxir]

Thanks Skip, Thankyou very much, its worked.

 

[SkipVought]

Dim CCtl As Word.[b]Paragraph[/b]

Paragraph SINGULAR!!!

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[umxir]

Worked for me. Previously its was not, But I copy paste again and Vola

 

[SkipVought]

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]