How do I concatenate / merge / join snapshot reports (Access 2000 VBA)
CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 6 of 6

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

  1. #1
    Join Date
    Jan 2011
    Posts
    5

    Question 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.

  2. #2
    Join Date
    Jan 2011
    Posts
    5

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

    sorry... posted to wrong forum.

  3. #3
    Join Date
    Jun 2010
    Location
    Germany
    Posts
    2,571

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

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

    Quote Originally Posted by Lebowski View Post
    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 View Post
    sorry... posted to wrong forum.
    Why do you think so?
    I was thrown out of college for cheating on the metaphysics exam; I looked into the soul of the boy sitting next to me.

    This is a snakeskin jacket! And for me it's a symbol of my individuality, and my belief... in personal freedom.

  4. #4
    Join Date
    Jan 2011
    Posts
    5

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

    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

  5. #5
    Join Date
    Jun 2010
    Location
    Germany
    Posts
    2,571

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

    Quote Originally Posted by Lebowski View Post
    I saw another forum dealing with MS Office products and it specifically stated "VBA".
    Really? Here on CodeGuru? 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.

    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.

    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
    I was thrown out of college for cheating on the metaphysics exam; I looked into the soul of the boy sitting next to me.

    This is a snakeskin jacket! And for me it's a symbol of my individuality, and my belief... in personal freedom.

  6. #6
    Join Date
    Jan 2011
    Posts
    5

    Thumbs up Re: How do I concatenate / merge / join snapshot reports (Access 2000 VBA)

    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


Azure Activities Information Page

Windows Mobile Development Center


Click Here to Expand Forum to Full Width

This is a CodeGuru survey question.


Featured


HTML5 Development Center