Loop through files and Copy Table Row and Paste into Different Document

[spiderman1369]

I have a folder with about 300 Word 2010 documents and each has a table in the document. The naming convention for the files is 3-ABC-DE-####.docx (where #### = numbers). I also have a file in the same directory named 3-ABC-FGH-001.docx (this is a table of contents file).

I need to copy the same specific row from the table in each of the 300 documents and sequentially paste each row into the Table of Contents file. Thus having 300 rows in the TOCs file.

Thus, loop through all 300 files, copy the specific row, and dump it into the TOC file.

Is it possible to do this with some vba code? Any sugguestions?

[macropod]

It's quite easy, really:

Sub GetData()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim wdDocSrc As Document, wdDocTgt As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set wdDocTgt = ActiveDocument
strFile = Dir(strFolder & "\3-ABC-DE-*.docx", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> wdDocTgt.FullName Then
    Set wdDocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDocSrc
      If .Tables.Count > 0 Then
        wdDocTgt.Paragraphs.Last.Range.FormattedText = .Tables(1).Rows(1).Range.FormattedText
      End If
      .Close SaveChanges:=False
    End With
  End If
  strFile = Dir()
Wend
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

All you need do is add the code to your target document and specify which table & row to use. As coded, the macro assumes the first table and the first row in that table.

[spiderman1369]

Thanks macropod...just got to try this...been on jury duty.