• Status: Solved
  • Priority: High
  • Security: Public
  • Views: 71
  • Last Modified:

Access VBA Create Word Header on Each Page

I'm using the following code and would like to create a Word header on each page. Thoughts?


Function Export2DOC(sQuery As String)
    Dim oWord           As Object
    Dim oWordDoc        As Object
    Dim oWordTbl        As Object
    Dim bWordOpened     As Boolean
    Dim db              As DAO.Database
    Dim rs              As DAO.Recordset
    Dim iCols           As Integer
    Dim iRecCount       As Integer
    Dim iFldCount       As Integer
    Dim i               As Integer
    Dim j               As Integer
    Const wdPrintView = 3
    Const wdWord9TableBehavior = 1
    Const wdAutoFitFixed = 0
 
 
    'Start Word
   On Error Resume Next
    Set oWord = GetObject("Word.Application")    'Bind to existing instance of Word
 
    If Err.Number <> 0 Then    'Could not get instance of Word, so create a new one
        Err.Clear
        On Error GoTo Error_Handler
        Set oWord = CreateObject("Word.application")
        bWordOpened = False
    Else    'Word was already running
        bWordOpened = True
    End If
    On Error GoTo Error_Handler
    oWord.Visible = False   'Keep Word hidden until we are done with our manipulation
    Set oWordDoc = oWord.Documents.Add   'Start a new document
 
    'Open our SQL Statement, Table, Query
    Set db = CurrentDb
    Set rs = db.OpenRecordset("tblSearch")
    With rs
        If .RecordCount <> 0 Then
            .MoveLast   'Ensure proper count
            iRecCount = .RecordCount + 1    'Number of records returned by the table/query
            .MoveFirst
            iFldCount = .Fields.Count   'Number of fields/columns returned by the table/query
 
            oWord.ActiveWindow.View.Type = wdPrintView 'Switch to print preview mode (not req&#39;d just a personal preference)
            oWord.ActiveDocument.Tables.Add Range:=oWord.Selection.Range, NumRows:=iRecCount, NumColumns:= _
                                            iFldCount, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
                                            wdAutoFitFixed
 
 
            'Build our Header Row

            Set oWordTbl = oWordDoc.Tables(1)
            oWordTbl.Rows(1).HeadingFormat = True
            
            For i = 0 To iFldCount - 1
                oWordTbl.Cell(1, i + 1) = rs.Fields(i).Name
            Next i

            i = 2 ' first row of data goes in 2nd row of table

            'Build our data rows
            Set oWordTbl = oWordDoc.Tables(1)

            Do Until rs.EOF = True
                For j = 0 To iFldCount - 1
                    oWordTbl.Cell(i, j + 1) = Nz(rs.Fields(j).Value, "")
                Next j
                .MoveNext
                i = i + 1
            Loop
        Else
            MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Word spreadsheet with"
            GoTo Error_Handler_Exit
        End If
    End With
 
    '    oWordDoc.Close True, sFileName 'Save and close
 
    'Close Word if is wasn't originally running
    '    If bWordOpened = False Then
    '        oWord.Quit
    '    End If
 
Error_Handler_Exit:
    On Error Resume Next
    oWord.Visible = True   'Make Word visible to the user
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set oWordTbl = Nothing
    Set oWordDoc = Nothing
    Set oWord = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Export2DOC" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

Open in new window

0
shieldsco
Asked:
shieldsco
  • 3
  • 2
  • 2
2 Solutions
 
NorieVBA ExpertCommented:
Is this a duplicate of this (solved) question Access VBA Add Column Heading to All Word Page?
0
 
shieldscoAuthor Commented:
No - I want to add a Word Header to each page not column headings as in the previous post. The text in the header = " Appendix of Appeals"
0
 
NorieVBA ExpertCommented:
Sorry, didn't read through the whole question.

If you want to add a header try this.
oWordDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "Appendix of Appeals"
 

Open in new window

0
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
Ryan ChongCommented:
for your codes, you should apply instead, like:

With oWord.ActiveDocument.Sections(1).Headers(1).Range
                .Text = "Appendix of Appeals"
                .Font.Italic = True
                .Paragraphs.Alignment = 2 'Align Right
            End With

Open in new window


use the numeric values instead of enums if you're not adding the Word Object library in your codes.
0
 
NorieVBA ExpertCommented:
Ryan

I was wondering if early or late binding was being used and was going to substitute wdHeaderFooterPrimary with it's value but earlier in the code Word VBA constants are being used, for example.
 oWord.ActiveWindow.View.Type = wdPrintView 

Open in new window

0
 
Ryan ChongCommented:
I was wondering if early or late binding was being used and was going to substitute wdHeaderFooterPrimary with it's value but earlier in the code Word VBA constants are being used, for example.
yes Norie, so in this case, if we're not adding a reference of Microsoft Word Object library, then we shall define a Constant for wdHeaderFooterPrimary if we wish to use it in the codes.
0
 
shieldscoAuthor Commented:
Thank you
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

  • 3
  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now