How do I concatenate / merge / join snapshot reports (Access 2000 VBA)

Hello,

I have many individual snapshot reports (customer invoices) that I would like to concatenate/merge into one big report.

Does anyone have any code examples on how to do this?

I'm thinking that when the individual report is created...

Code:

---

        DoCmd.OpenReport REPORTNAME, acViewPreview
       
        outputFilename = "P" & Reports(REPORTNAME).Pages & "_" & outputFilename
        fileToSave = SAVEPATH & outputFilename
       
        DoCmd.OutputTo acOutputReport, REPORTNAME, acFormatRTF, fileToSave, False

---

...that another report (I'll called it the "merged report") would be opened and appended with the individual report.
If there is a better way, I am open to suggestions.

My other option is to somehow concatenate/merge the RTF files. Does anyone have any VBA examples of this?

Many Many Thanks, Gurus!

L.

sorry... posted to wrong forum.

I don't know enough about Access to help you with this part but...

Quote:

---

Originally Posted by Lebowski

My other option is to somehow concatenate/merge the RTF files. Does anyone have any VBA examples of this?

---

You can do that by employig Word. You certainly know that you can remote-control Word from an Access VBA macro. If this is an option for you and you want assistance, please report back.

HTH

Quote:

---

Originally Posted by Lebowski

sorry... posted to wrong forum.

---

Why do you think so?

Hi Eri523,

I saw another forum dealing with MS Office products and it specifically stated "VBA".

However, yes, I could use some help with remote-controlling Word via Access. I'm not sure how the copy from Access and paste into Word process will work. If you have some info on that, I'd really be interested in learning about it.

Thanks,

Lebowski

Quote:

---

Originally Posted by Lebowski

I saw another forum dealing with MS Office products and it specifically stated "VBA".

---

Really? Here on CodeGuru? :ehh: I know we have a database forum, but AFAIK none on Office. And VBA questions I've always seen being handled here in the VB6 forum. If you know something I don't please tell me. :)

Quote:

---

However, yes, I could use some help with remote-controlling Word via Access. I'm not sure how the copy from Access and paste into Word process will work. If you have some info on that, I'd really be interested in learning about it.

---

Well, there actually is a way to directly transfer an Access report to Word ("Publish with MS Office Word" - which also implicitly saves it as RTF), but I don't think this actually would simplify concatenating reports.

Instead, I assume you already have saved your individual reports as RTF using "File -> Export...". (Of course you can automate this using VBA code as well and then call my code from that macro.) This VBA macro can concatenate an arbitrary (at least one) number of RTF files:

Code:

---

Option Compare Database
Option Explicit

Const wdStory = 6
Const wdFormatRTF = 6

Sub ConcatRTF(astrInputFileName() As String, strOutputFileName As String)
  Dim wordapp As Object
  Dim bWordNotAlreadyRunning As Boolean
  Dim i As Integer
 
  On Error Resume Next
  Set wordapp = GetObject(, "Word.Application")
  On Error GoTo 0
  If wordapp Is Nothing Then
    Set wordapp = CreateObject("Word.Application")
    bWordNotAlreadyRunning = True
  End If
 
  wordapp.Documents.Open astrInputFileName(LBound(astrInputFileName)), ConfirmConversions:=False, AddToRecentFiles:=False
  wordapp.Selection.EndKey wdStory
  For i = LBound(astrInputFileName) + 1 To UBound(astrInputFileName)
    wordapp.Selection.InsertBreak
    wordapp.Selection.InsertFile astrInputFileName(i), ConfirmConversions:=False
  Next
  wordapp.ActiveDocument.SaveAs strOutputFileName, wdFormatRTF, AddToRecentFiles:=False
  wordapp.ActiveDocument.Close
  If bWordNotAlreadyRunning Then wordapp.Quit
  Set wordapp = Nothing
End Sub

---

Well, while this is meant to be run under Access, it is not really an Access macro: Practically all its functionality is based on the remote-controlled Word. :cool:

It is called passing an array of strings containing input file names and a single string with an output file name as parameters, e.g. like this:

Code:

---

Sub Test()
  Dim astrInputFiles(2) As String
  astrInputFiles(0) = "c:\CGTest\R1.rtf"
  astrInputFiles(1) = "c:\CGTest\R2.rtf"
  astrInputFiles(2) = "c:\CGTest\R3.rtf"
  ConcatRTF astrInputFiles, "c:\CGTest\R-all.rtf"
End Sub

---

Note that file names passed to the concatenation macro should always be fully qualified and must be enclosed in doble quotes if they contain spaces. For demonstration purposes I used a folder directly located in the system volume's root folder here, but that's of course not where the files should be stored in real life.

At least in my last test so far, the concatenated report file had a single empty page at the end. If you can reproduce that and it should be an issue, I may get back to the macro and try to fix that.

HTH

Hey Eri523,

Just wanted to say THANKS ALOT!!! That helped and worked a LOT!!!

I tweaked it a bit to fit my situation and came up with this. Maybe someone else will need a similar solution:

Code:

---

Attribute VB_Name = "MergeRTFfiles"

Option Explicit
Option Base 1

Const wdStory = 6
Const wdFormatRTF = 6


Sub ConcatRTF(astrInputFileName() As String, strOutputFileName As String)
    Dim wordApp As Word.Application
    'Dim wordapp As Object
    Dim bWordNotAlreadyRunning As Boolean
    Dim i As Integer
 
    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
   
    On Error GoTo 0
   
    If wordApp Is Nothing Then
        Set wordApp = CreateObject("Word.Application")
        bWordNotAlreadyRunning = True
    End If
 
    wordApp.Documents.Open astrInputFileName(LBound(astrInputFileName)), ConfirmConversions:=False, AddToRecentFiles:=False
    wordApp.Selection.EndKey wdStory
    For i = LBound(astrInputFileName) + 1 To UBound(astrInputFileName)
        wordApp.Selection.InsertBreak
        wordApp.Selection.InsertFile astrInputFileName(i), ConfirmConversions:=False
    Next
 
    wordApp.ActiveDocument.SaveAs strOutputFileName, wdFormatRTF, AddToRecentFiles:=False
    wordApp.ActiveDocument.Close
   
    If bWordNotAlreadyRunning Then
        wordApp.Quit
    End If
   
    Set wordApp = Nothing
    End
End Sub

Sub Main()
   
    Dim Folder_Name As String
    Dim promptTxt As String
   
    Dim counter As Long
   
    'array counters
    Dim counter2  As Long
    Dim counter3 As Long
    Dim counter4 As Long
    Dim counter5 As Long
    Dim counter6 As Long
    Dim counter7 As Long
   
    Dim fso As New fileSystemObject
    Dim fil As File
    Dim fld As Folder
    Dim fileCount As Long
    Dim astrInputFiles() As String
    Dim arr2Pages() As String  'array for files containing 2 pages
    Dim arr3Pages() As String  'array for files containing 3 pages
    Dim arr4Pages() As String  'array for files containing 4 pages
    Dim arr5Pages() As String  'array for files containing 5 pages
    Dim arr6Pages() As String  'array for files containing 6 pages
    Dim arr7Pages() As String  'array for files containing 7 pages
   
    counter = 1
    counter2 = 1
    counter3 = 1
    counter4 = 1
    counter5 = 1
    counter6 = 1
    counter7 = 1

    promptTxt = "Please navigate to the folder containing the RTF files"
    Folder_Name = DirDialog(promptTxt, "C:\")
    If Right(Folder_Name, 1) <> "\" Then
        Folder_Name = Folder_Name & "\"
    End If
   
    Set fld = fso.GetFolder(Folder_Name)
    fileCount = fld.Files.Count
'    ReDim astrInputFiles(fileCount)
'    For Each fil In fld.Files
'        astrInputFiles(counter) = FOLDER_NAME & fil.Name
'        Debug.Print "astrInputFiles(" & counter & "): " & astrInputFiles(counter)
'        counter = counter + 1
'    Next fil
   
    ReDim arr2Pages(fileCount)
    ReDim arr3Pages(fileCount)
    ReDim arr4Pages(fileCount)
    ReDim arr5Pages(fileCount)
    ReDim arr6Pages(fileCount)
    ReDim arr7Pages(fileCount)  'arr7Pages will hold all files with 7 or more pages

   
   
    For Each fil In fld.Files
        'Based on the number of pages in the file, assign to associated array
        'Filename starts with "P#_" or "P##" - the number of pages in the file
        If Left(fil.Name, 1) = "P" Then
            Select Case Left(fil.Name, 3)
                Case "P2_":
                            arr2Pages(counter2) = Folder_Name & fil.Name
                            counter2 = counter2 + 1
                Case "P3_":
                            arr3Pages(counter3) = Folder_Name & fil.Name
                            counter3 = counter3 + 1
                Case "P4_":
                            arr4Pages(counter4) = Folder_Name & fil.Name
                            counter4 = counter4 + 1
                Case "P5_":
                            arr5Pages(counter5) = Folder_Name & fil.Name
                            counter5 = counter5 + 1
                Case "P6_":
                            arr6Pages(counter6) = Folder_Name & fil.Name
                            counter6 = counter6 + 1
                Case Else:
                            arr7Pages(counter7) = Folder_Name & fil.Name
                            counter7 = counter7 + 1
            End Select
        End If
        'astrInputFiles(counter) = FOLDER_NAME & fil.Name
        'Debug.Print "File(" & counter & "): " & fil.Name
        counter = counter + 1
        DoEvents
    Next fil
   
'    astrInputFiles(0) = "c:\CGTest\R1.rtf"
'    astrInputFiles(1) = "c:\CGTest\R2.rtf"
'    astrInputFiles(2) = "c:\CGTest\R3.rtf"
'    ConcatRTF astrInputFiles, "c:\CGTest\R-all.rtf"
'    ConcatRTF astrInputFiles, FOLDER_NAME & "R-all.rtf"
   
    ConcatRTF arr2Pages, Folder_Name & Format(Date, "yyyymmdd") & "_EquipLocChangeLetters_2Page.rtf"
    ConcatRTF arr3Pages, Folder_Name & Format(Date, "yyyymmdd") & "_EquipLocChangeLetters_3Page.rtf"
    ConcatRTF arr4Pages, Folder_Name & Format(Date, "yyyymmdd") & "_EquipLocChangeLetters_4Page.rtf"
    ConcatRTF arr5Pages, Folder_Name & Format(Date, "yyyymmdd") & "_EquipLocChangeLetters_5Page.rtf"
    ConcatRTF arr6Pages, Folder_Name & Format(Date, "yyyymmdd") & "_EquipLocChangeLetters_6Page.rtf"
    ConcatRTF arr7Pages, Folder_Name & Format(Date, "yyyymmdd") & "_EquipLocChangeLetters_7Page.rtf"
   
    MsgBox "Finished merging RTF files.", vbInformation
    End
End Sub




'**************************************************************************************************
'Name:              DirDialog
'Description:      This function call the system folder browser and returns the selected path
'                  Requires the reference "Microsoft Shell Controls And Automation"
'Parameters:        A string user prompt (promptTxt) and the initial browser path (defaultPath)
'Called By:        Archive()
'Calls to:          Shell browser
'Value Returned:    a string value of the selected path
'**************************************************************************************************
Function DirDialog(promptTxt As String, defaultPath As String) As String
    Set objShell = New Shell
    Set objFolder = objShell.BrowseForFolder(0, promptTxt, 0, defaultPath)
   
    If Not (objFolder Is Nothing) Then
        Set objFolderItem = objFolder.Self
        DirDialog = objFolderItem.Path
    End If
   
    Set objShell = Nothing
    Set objFolder = Nothing
   
End Function

---

Thanks again for your help!!!!!!!!!!!!!

Lebowski