Merging word documents containing tables

knpaddac · #1 11-26-2023, 07:56 PM

I frequently have to merge many (even hundreds of them) Word documents into one. Recently many of these have included content that is in tables within the documents. In the resulting doc, I am getting line breaks (enters) between the content from each cell but I want it to be tabs. Can anybody help me with this? I have included the code below as I am currently using it:

Code:

Sub Import_Text()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document, rtfFile As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.rtf", vbNormal)
Set wdDoc = ActiveDocument
While strFile <> ""
  Set rtfFile = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False, ConfirmConversions:=False)
  wdDoc.Range.InsertAfter rtfFile & vbCr & rtfFile.Range.Text & vbCr
  rtfFile.Close SaveChanges:=True
  strFile = Dir()
Wend
Set rtfFile = Nothing: Set wdDoc = 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

Guessed · #2 11-27-2023, 02:49 PM

Do you really want this as text only? Wouldn't it be better to import the content with its formatting & tables retained?

knpaddac · #3 11-27-2023, 04:04 PM

Yes, that would be fine as well.

Quote:

Originally Posted by Guessed

Do you really want this as text only? Wouldn't it be better to import the content with its formatting & tables retained?

Guessed · #4 11-27-2023, 05:27 PM

Try this version

Code:

Sub Import_Text()
  Dim strFolder As String, strFile As String, wdDoc As Document
  Application.ScreenUpdating = False
  strFolder = GetFolder
  If strFolder = "" Then Exit Sub
  strFile = Dir(strFolder & "\*.rtf", vbNormal)
  ChangeFileOpenDirectory strFolder
  Set wdDoc = ActiveDocument
  
  While strFile <> ""
    wdDoc.Range.InsertAfter vbCr & strFile & vbCr
    wdDoc.Range.Paragraphs.Last.Range.InsertFile FileName:=strFolder & "\" & strFile, ConfirmConversions:=False, Link:=False, Attachment:=False
    strFile = Dir()
  Wend
  Set wdDoc = Nothing
  Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
  Dim oFolder As Object
  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

knpaddac · #5 11-27-2023, 07:32 PM

This does pull all the content in BUT it does not put the filenames in the resulting document like the previous version did.

Quote:

Originally Posted by Guessed

Try this version

Code:

Sub Import_Text()
  Dim strFolder As String, strFile As String, wdDoc As Document
  Application.ScreenUpdating = False
  strFolder = GetFolder
  If strFolder = "" Then Exit Sub
  strFile = Dir(strFolder & "\*.rtf", vbNormal)
  ChangeFileOpenDirectory strFolder
  Set wdDoc = ActiveDocument
  
  While strFile <> ""
    wdDoc.Range.Paragraphs.Last.Range.InsertFile FileName:=strFolder & "\" & strFile, ConfirmConversions:=False, Link:=False, Attachment:=False
    strFile = Dir()
  Wend
  Set wdDoc = Nothing
  Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
  Dim oFolder As Object
  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

Guessed · #6 11-27-2023, 07:40 PM

I added a line in the earlier post to include the filename. It is the red one.

knpaddac · #7 11-27-2023, 07:57 PM

This seems to be exactly what I need. Thank you very much! Will save me tons of time.

Quote:

Originally Posted by Guessed

I added a line in the earlier post to include the filename. It is the red one.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Merging Word documents	kp4bnx	Word VBA	4	03-10-2021 02:49 PM
Batch merging of Word documents	Harry Gateaux	Word VBA	6	11-19-2020 09:58 AM
Updating links while merging Word documents	ndw	Word VBA	1	11-10-2017 01:07 PM
Merging two tables in WORD with VBA	ffinley	Word VBA	3	03-14-2017 07:43 PM
Merging different documents in one big document keeping the chapters, figure numbers and tables	village	Word	8	06-06-2016 04:16 AM