Results 1 to 6 of 6
  1. #1
    besuchanko is offline Advanced Beginner
    Windows XP Access 2007
    Join Date
    Jan 2013
    Posts
    32

    VBA Grouping via Word Automation

    I wasn't sure how to title my thread. This is what i want to do, and I'm not sure if it's possible or not. You know how when you create an Access report, you can group by a field in the underlying query? I want to do the same thing with VBA automation to a Word document. Can that be done? If so, how??

    Scenario: Each line of my query lists the name of a course and the teacher. There are multiple teachers within each course, so a single course is listed for each instance of a teacher for that course. I want my resulting Word document to create a page by course, and then loop through and list all the teachers within that course, along with numerous of their personal details (name, address, pay rate, etc...the list is long). How on earth do you do that? It's so simple in an Access report (I just group by the course ID), but I want to take advantage of Word's powerful formatting features. Hence automation to Word. I'm at a loss.

  2. #2
    June7's Avatar
    June7 is offline VIP
    Windows XP Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,815
    I haven't done much with Word/Access mail merge but I don't think it can accomplish that. AFAIK, mail merge can be for one record at a time. Could possibly construct a table in Word and feed the child records into it. http://www.dslreports.com/forum/remark,20002102
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  3. #3
    besuchanko is offline Advanced Beginner
    Windows XP Access 2007
    Join Date
    Jan 2013
    Posts
    32
    I have an idea that I'm going to try. I'm thinking of pulling the data from multiple recordsets and doing some sort of a nested loop. I'm thinking possibly a Do While statement to match teachers to courses.

  4. #4
    besuchanko is offline Advanced Beginner
    Windows XP Access 2007
    Join Date
    Jan 2013
    Posts
    32

    VBA Automation to Word: Multiple Tables in Nested Loop

    I'm sure this isn't too hard, but my brain just can't figure it out. I am exporting a report to word via VBA automation. No problems there. I have a series of two nested loops...an outer loop and an inner loop. The outer loop creates a table and inserts various data for an educational offering. Each new table in the outer loop begins on a new page in the Word document. That was working fine until I tried adding a table in the inner loop. The inner loop should contain a table with various data for the instructor for each educational offering in the outer loop. There is usually more than one instructor for each educational offering.

    So...I created a count for each table in the outer loop that starts at 1 (since Word counts each successive table as 1, 2, 3, etc.). The count for the inner loop needs to start at 2 (for Table 2) and count up to represent each successful table for all the instructors in the educational offering. Then when the inner loop is done counting up, the outer loop needs to begin again at the ending count for the inner loop + 1 (on the next page of the Word document). I'm messing the count up somehow. Can anyone help???

    Example:

    Page 1
    Educational offering 1 (Table 1)
    Instructor 1 (Table 2)
    Instructor 2 (Table 3)

    Page 2
    Educational offering 2 (Table 4)
    Instructor 1 (Table 5)
    Instructor 2 (Table 6)
    Instructor 3 (Table 7)

    etc...

    My code is below. I'm almost there...It's generating the correct number of tables on each page, but it isn't putting the data into them beyond table 1.

    Code:
    Private Sub Command0_Click()
    Dim WordApp As Word.Application
    Dim doc As Word.Document
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim fld As Field
    Dim intLoop As Integer
    Dim intLoop2 As Integer
    Dim x As Integer
    
    'Check to see if Word is already running and either Get or Create a new instance
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set WordApp = CreateObject("Word.Application")
    End If
    
    Set doc = WordApp.Documents.Add
    With WordApp
        .Visible = True
        .Activate
        .WindowState = wdWindowStateNormal
    End With
       
    'Set line spacing and alignment
        With WordApp.Selection.ParagraphFormat
            .LeftIndent = InchesToPoints(0)
            .RightIndent = InchesToPoints(0)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
            .WidowControl = True
            .KeepWithNext = False
            .KeepTogether = False
            .PageBreakBefore = False
            .NoLineNumber = False
            .Hyphenation = True
            .FirstLineIndent = InchesToPoints(0)
            .OutlineLevel = wdOutlineLevelBodyText
            .CharacterUnitLeftIndent = 0
            .CharacterUnitRightIndent = 0
            .CharacterUnitFirstLineIndent = 0
            .LineUnitBefore = 0
            .LineUnitAfter = 0
            .MirrorIndents = False
            .TextboxTightWrap = wdTightNone
        End With
    WordApp.Selection.Font.Name = "Calibri"
    WordApp.Selection.Font.Size = 11
       
    Set db = CurrentDb()
    Set rst1 = db.OpenRecordset("SessionsList_Qry")
    Set rst2 = db.OpenRecordset("PresenterData_Query")
    
    x = 1
    xy = x + 1
    
    'Outer Loop
    If rst1.RecordCount = 0 Then Exit Sub
    
    rst1.MoveFirst
    Do Until rst1.EOF
        Set Para1 = doc.Content.Paragraphs.Add
        Para1.Range.InsertParagraphAfter
        Para1.Range.Font.Size = "14"
        Para1.Range.Font.Bold = True
        Para1.Range.Text = "Session Proof Report"
        Para1.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        
    
        Set Para2 = doc.Content.Paragraphs.Add
        Para2.Range.InsertParagraphAfter
        Para2.Range.Font.Size = "12"
        Para2.Range.Font.Bold = True
        Para2.Range.Text = "2013 National Pharmacy Preceptors Conference"
        Para2.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        
       
     'Insert a blank line between previous paragraph and table
        Set Para3 = doc.Content.Paragraphs.Add
        Para3.Range.Font.Size = "11"
        Para3.Range.Font.Bold = False
        Para3.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
        
       
     'Insert Table
        Set Para4 = doc.Content.Paragraphs.Add
        Para4.Range.InsertParagraphAfter
        Para4.Range.Tables.Add Range:=Para4.Range, NumRows:=7, NumColumns:= _
            2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
            False
        With Para4.Range.Tables(1)
            If .Style <> "Table Grid" Then
                .Style = "Table Grid"
            End If
            .ApplyStyleHeadingRows = True
            .ApplyStyleLastRow = False
            .ApplyStyleFirstColumn = True
            .ApplyStyleLastColumn = False
            .ApplyStyleRowBands = True
            .ApplyStyleColumnBands = False
        End With
        
      
      'Add Text to Table
        intLoop = x
        With WordApp.ActiveDocument.Tables(intLoop)
            .Columns(1).SetWidth ColumnWidth:=144, RulerStyle:=wdAdjustProportional
            .Cell(1, 1).Range.Bold = True
            .Cell(1, 1).Range.InsertAfter "Session Number:"
            .Cell(1, 2).Range.InsertAfter Nz((rst1![SessionNum]), "")
            .Cell(2, 1).Range.Bold = True
            .Cell(2, 1).Range.InsertAfter "Project Manager:"
            .Cell(2, 2).Range.InsertAfter Nz((rst1![PM]), "")
            .Cell(3, 1).Range.Bold = True
            .Cell(3, 1).Range.InsertAfter "Session Title:"
            .Cell(3, 2).Range.InsertAfter Nz((rst1![SessionTitle]), "")
            .Cell(4, 1).Range.Bold = True
            .Cell(4, 1).Range.InsertAfter "Day/Time:"
            .Cell(4, 2).Range.InsertAfter Nz((Format(rst1![Date], "Long Date")), "") & " | " & Nz((Format(rst1![StartTime], "h:nn AM/PM")), "") & " - " & Nz((Format(rst1![EndTime], "h:nn AM/PM")), "")
            .Cell(5, 1).Range.Bold = True
            .Cell(5, 1).Range.InsertAfter "Repeat Day/Time:"
            .Cell(5, 2).Range.InsertAfter Nz((rst1![Repeat_Span]), "")
            .Cell(6, 1).Range.Bold = True
            .Cell(6, 1).Range.InsertAfter "ACPE Activity #:"
            .Cell(6, 2).Range.InsertAfter Nz((rst1![ACPE_Formatted]), "")
            .Cell(7, 1).Range.Bold = True
            .Cell(7, 1).Range.InsertAfter "Learning Objectives:"
            .Cell(7, 2).Range.InsertAfter Nz((rst1![LO1]), "") & vbCrLf & vbCrLf & Nz((rst1![LO2]), "") & vbCrLf & vbCrLf & Nz((rst1![LO3]), "") & vbCrLf & vbCrLf & Nz((rst1![LO4]), "") & vbCrLf & vbCrLf & Nz((rst1![LO5]), "")
        End With
        
          
            'Inner Loop
            If rst2.RecordCount = 0 Then Exit Sub
            
            rst2.MoveFirst
            Do Until rst2.EOF
                If rst1![SessionID] = rst2![SessionID] Then
                
                    'Insert second table
                        Set Para5 = doc.Content.Paragraphs.Add
                        Para5.Range.InsertParagraphAfter
                        Para5.Range.Tables.Add Range:=Para5.Range, NumRows:=3, NumColumns:= _
                            2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
                            False
                        With Para5.Range.Tables(2)
                            If .Style <> "Table Grid" Then
                                .Style = "Table Grid"
                            End If
                            .ApplyStyleHeadingRows = True
                            .ApplyStyleLastRow = False
                            .ApplyStyleFirstColumn = True
                            .ApplyStyleLastColumn = False
                            .ApplyStyleRowBands = True
                            .ApplyStyleColumnBands = False
                        End With
                        
                        'Add Text to Table
                        intLoop2 = xy
                        With WordApp.ActiveDocument.Tables(intLoop2)
                        
                            .Columns(1).SetWidth ColumnWidth:=144, RulerStyle:=wdAdjustProportional
                            
                            .Cell(1, 1).Range.Bold = True
                            .Cell(1, 1).Range.InsertAfter "Presenter:"
                            .Cell(1, 2).Range.InsertAfter Nz((rst2![FullName_Credentials]), "")
                            
                            .Cell(2, 1).Range.Bold = True
                            .Cell(2, 1).Range.InsertAfter "Email:"
                            .Cell(2, 2).Range.InsertAfter Nz((rst2![Email]), "")
                            
                            .Cell(3, 1).Range.Bold = True
                            .Cell(3, 1).Range.InsertAfter "Primary Position:"
                            .Cell(3, 2).Range.InsertAfter Nz((rst2![Primary_Position]), "")
                        End With
                End If
                rst2.MoveNext
                
                xy = xy + 1
           Loop
                    
                    
            'Page Break
            Set Para9 = doc.Content.Paragraphs.Add
            Para9.Range.InsertParagraphAfter
            Para9.Range.InsertBreak Type:=wdPageBreak
            
            rst1.MoveNext
            
            x = xy + 1
        Loop
        
        
    rst1.Close
    rst2.Close
    Set rst1 = Nothing
    Set rst2 = Nothing
    Set db = Nothing
    Set doc = Nothing
    Set WordApp = Nothing
    End Sub

  5. #5
    June7's Avatar
    June7 is offline VIP
    Windows XP Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,815
    Have you step debugged?

    I don't think need the xy variable. Increment x when creating the inner table instead of using xy. Otherwise think xy = x + 1 needs to be inside the outer loop.
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  6. #6
    besuchanko is offline Advanced Beginner
    Windows XP Access 2007
    Join Date
    Jan 2013
    Posts
    32
    Your suggestion was very helpful. I move around the placement of my variables and got rid of the xy variable. It's now working perfectly. I'll post the code below in case it helps anyone else out. I've put in red text the code that made it all work.

    Code:
    Private Sub Command0_Click()Dim WordApp As Word.Application
    Dim doc As Word.Document
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim fld As Field
    Dim intLoop As Integer
    Dim x As Integer
    
    
    'Check to see if Word is already running and either Get or Create a new instance
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    
    
    If Err.Number <> 0 Then
        Set WordApp = CreateObject("Word.Application")
    End If
    
    
    Set doc = WordApp.Documents.Add
    
    
    With WordApp
        .Visible = True
        .Activate
        .WindowState = wdWindowStateNormal
    End With
       
    'Set line spacing and alignment
        With WordApp.Selection.ParagraphFormat
            .LeftIndent = InchesToPoints(0)
            .RightIndent = InchesToPoints(0)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
            .WidowControl = True
            .KeepWithNext = False
            .KeepTogether = False
            .PageBreakBefore = False
            .NoLineNumber = False
            .Hyphenation = True
            .FirstLineIndent = InchesToPoints(0)
            .OutlineLevel = wdOutlineLevelBodyText
            .CharacterUnitLeftIndent = 0
            .CharacterUnitRightIndent = 0
            .CharacterUnitFirstLineIndent = 0
            .LineUnitBefore = 0
            .LineUnitAfter = 0
            .MirrorIndents = False
            .TextboxTightWrap = wdTightNone
        End With
    
    
    WordApp.Selection.Font.Name = "Calibri"
    WordApp.Selection.Font.Size = 11
       
    Set db = CurrentDb()
    Set rst1 = db.OpenRecordset("SessionsList_Qry")
    Set rst2 = db.OpenRecordset("PresenterData_Query")
    
    
    x = 1
    
    
    'Outer Loop
    If rst1.RecordCount = 0 Then Exit Sub
    
    
    rst1.MoveFirst
    Do Until rst1.EOF
    
    
        Set Para1 = doc.Content.Paragraphs.Add
        Para1.Range.InsertParagraphAfter
        Para1.Range.Font.Size = "14"
        Para1.Range.Font.Bold = True
        Para1.Range.Text = "Session Proof Report"
        Para1.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        
        Set Para2 = doc.Content.Paragraphs.Add
        Para2.Range.InsertParagraphAfter
        Para2.Range.Font.Size = "12"
        Para2.Range.Font.Bold = True
        Para2.Range.Text = "2013 National Pharmacy Preceptors Conference"
        Para2.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        
        'Insert a blank line between previous paragraph and table
        Set Para3 = doc.Content.Paragraphs.Add
        Para3.Range.Font.Size = "11"
        Para3.Range.Font.Bold = False
        Para3.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
        
        'Insert Table
        intLoop = x
        Set Para4 = doc.Content.Paragraphs.Add
        Para4.Range.InsertParagraphAfter
        Para4.Range.Tables.Add Range:=Para4.Range, NumRows:=7, NumColumns:= _
            2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
            False
        With Para4.Range.Tables(intLoop)
            If .Style <> "Table Grid" Then
                .Style = "Table Grid"
            End If
            .ApplyStyleHeadingRows = True
            .ApplyStyleLastRow = False
            .ApplyStyleFirstColumn = True
            .ApplyStyleLastColumn = False
            .ApplyStyleRowBands = True
            .ApplyStyleColumnBands = False
        End With
        
        'Add Text to Table
        With WordApp.ActiveDocument.Tables(intLoop)
            .Columns(1).SetWidth ColumnWidth:=144, RulerStyle:=wdAdjustProportional
            .Cell(1, 1).Range.Bold = True
            .Cell(1, 1).Range.InsertAfter "Session Number:"
            .Cell(1, 2).Range.InsertAfter Nz((rst1![SessionNum]), "")
            .Cell(2, 1).Range.Bold = True
            .Cell(2, 1).Range.InsertAfter "Project Manager:"
            .Cell(2, 2).Range.InsertAfter Nz((rst1![PM]), "")
            .Cell(3, 1).Range.Bold = True
            .Cell(3, 1).Range.InsertAfter "Session Title:"
            .Cell(3, 2).Range.InsertAfter Nz((rst1![SessionTitle]), "")
            .Cell(4, 1).Range.Bold = True
            .Cell(4, 1).Range.InsertAfter "Day/Time:"
            .Cell(4, 2).Range.InsertAfter Nz((Format(rst1![Date], "Long Date")), "") & " | " & Nz((Format(rst1![StartTime], "h:nn AM/PM")), "") & " - " & Nz((Format(rst1![EndTime], "h:nn AM/PM")), "")
            .Cell(5, 1).Range.Bold = True
            .Cell(5, 1).Range.InsertAfter "Repeat Day/Time:"
            .Cell(5, 2).Range.InsertAfter Nz((rst1![Repeat_Span]), "")
            .Cell(6, 1).Range.Bold = True
            .Cell(6, 1).Range.InsertAfter "ACPE Activity #:"
            .Cell(6, 2).Range.InsertAfter Nz((rst1![ACPE_Formatted]), "")
            .Cell(7, 1).Range.Bold = True
            .Cell(7, 1).Range.InsertAfter "Learning Objectives:"
            .Cell(7, 2).Range.InsertAfter Nz((rst1![LO_String]), "")
        End With
        
           'Inner Loop
            If rst2.RecordCount = 0 Then Exit Sub
            
            rst2.MoveFirst
            Do Until rst2.EOF
                If rst1![SessionID] = rst2![SessionID] Then
                
                    'Insert second table
                        x = x + 1
                        Set Para5 = doc.Content.Paragraphs.Add
                        Para5.Range.InsertParagraphAfter
                        Para5.Range.Tables.Add Range:=Para5.Range, NumRows:=3, NumColumns:= _
                            2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
                            False
                        With Para5.Range.Tables(intLoop)
                            If .Style <> "Table Grid" Then
                                .Style = "Table Grid"
                            End If
                            .ApplyStyleHeadingRows = True
                            .ApplyStyleLastRow = False
                            .ApplyStyleFirstColumn = True
                            .ApplyStyleLastColumn = False
                            .ApplyStyleRowBands = True
                            .ApplyStyleColumnBands = False
                        End With
                        
                        'Add Text to Table
                        With WordApp.ActiveDocument.Tables(x)
                        
                            .Columns(1).SetWidth ColumnWidth:=144, RulerStyle:=wdAdjustProportional
                            
                            .Cell(1, 1).Range.Bold = True
                            .Cell(1, 1).Range.InsertAfter "Presenter:"
                            .Cell(1, 2).Range.InsertAfter Nz((rst2![FullName_Credentials]), "")
                            
                            .Cell(2, 1).Range.Bold = True
                            .Cell(2, 1).Range.InsertAfter "Email:"
                            .Cell(2, 2).Range.InsertAfter Nz((rst2![Email]), "")
                            
                            .Cell(3, 1).Range.Bold = True
                            .Cell(3, 1).Range.InsertAfter "Primary Position:"
                            .Cell(3, 2).Range.InsertAfter Nz((rst2![Primary_Position]), "")
                        End With
    
    
                End If
                rst2.MoveNext
                
           Loop
                             
            'Page Break
            Set Para9 = doc.Content.Paragraphs.Add
            Para9.Range.InsertParagraphAfter
            Para9.Range.InsertBreak Type:=wdPageBreak
            
            rst1.MoveNext
            x = x + 1
        Loop
        
        
    rst1.Close
    rst2.Close
    Set rst1 = Nothing
    Set rst2 = Nothing
    Set db = Nothing
    Set doc = Nothing
    Set WordApp = Nothing
    
    
    End Sub

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Automation to Word using Crosstab Query
    By besuchanko in forum Import/Export Data
    Replies: 3
    Last Post: 07-22-2013, 03:19 PM
  2. Automation to Word Crash
    By besuchanko in forum Programming
    Replies: 5
    Last Post: 03-02-2013, 08:54 PM
  3. Replies: 2
    Last Post: 04-19-2012, 12:43 PM
  4. Word Automation in Windows 7
    By tmbowden in forum Access
    Replies: 0
    Last Post: 01-23-2012, 01:17 PM
  5. Access and Word Automation
    By djreyrey in forum Forms
    Replies: 1
    Last Post: 01-08-2010, 02:33 PM

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
  •  
Other Forums: Microsoft Office Forums