Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Getting MS Word file name along with Paragraphs into Excel 1

Status
Not open for further replies.

umxir

Technical User
Oct 21, 2018
9
PK
Hello Fellows,

Using below attached VB code to extract few starting paragraphs from Word into Excel. Working great.

Now, I also want to include the word file name to be extracted from where the paragraphs has come.

Please help me as I am totally newbie here.

Code:
Sub getWordData()
Dim wdApp As New Word.Application
Dim myDoc As Word.Document
Dim CCtl As Word.Paragraph
Dim myFolder As String, strFile As String
Dim myWkSht As Worksheet, i As Long, j As Long


'Open Folder Dialog Box Option
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
'End Open Folder Dialog Box Option


Application.ScreenUpdating = False

If myFolder = "" Then Exit Sub

Set myWkSht = ActiveSheet
ActiveSheet.Cells.Clear

 
 i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row
 strFile = Dir(myFolder & "\*.doc", 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 .Paragraphs
            j = j + 1
            myWkSht.Cells(i, j) = CCtl.Range.Text
            If j = 10 Then Exit For
        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
 
Hi,
Code:
‘
With myDoc
    j = 0
        For Each CCtl In .Paragraphs
            j = j + 1
            myWkSht.Cells(i, j) = CCtl.Range.Text
            If j = 10 Then Exit For
        Next
        [b]myWkSht.Cells(i, j+1) = .Name[/b]
    myWkSht.Columns.AutoFit
 End With

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Skip, You are a Legend, Working great,

Just a little bit further improvement, Code is printing name in the last column, Is it possible to get file name into first Column?
 
Code:
With myDoc
    j = 1
    myWkSht.Cells(i, j) = .Name

    For Each CCtl In .Paragraphs
        j = j + 1
        myWkSht.Cells(i, j) = CCtl.Range.Text
        If j = 11 Then Exit For
    Next

    myWkSht.Columns.AutoFit
 End With

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top