Create Word Document from Access DB

ASP Free Forums Sponsor:

July 12th, 2006, 02:15 AM

jmurrayhead

Moderator

ASP Free God 17th Plane (13000 - 13499 posts)

Join Date: Feb 2004

Location: Reston, VA, USA

Posts: 13,091

Folding Points: 88298 Folding Title: Advanced Folder

Time spent in forums: 3 Months 1 Week 11 h 23 m 46 sec
Reputation Power: 1580

Create Word Document from Access DB

Hello all,

I'm trying to create a Word document from my Access app and populate it with data from my database. I've looked up on some ways to do it, but not much is explained on how to perform certain actions. I'm also not quite sure on how to get my Word template to work how I want it. I have attached a document of what I would like the report I'm trying to generate look like. All items in grey are items pulled from tables in my database. If anyone can assist me on how to do this would be great.

Thanks!

Attached Files

OPREP_TEMP.doc (27.0 KB, 222 views)

__________________
jmurrayhead

Did I help you out? Make me popular by clicking the

icon!

New Members:Proper way to post a question

Powered by ASP.Net

July 12th, 2006, 03:02 AM

nofriends

Senior Water Wizard

ASP Free God 11th Plane (10000 - 10499 posts)

Join Date: Aug 2004

Location: Cape Town, RSA

Posts: 10,186

Folding Points: 112786 Folding Title: Super Ultimate Folder - Level 1

Time spent in forums: 3 Months 2 Weeks 2 Days 7 h 36 m 24 sec
Reputation Power: 699

Hi JMH,

I think you can use form fields in Word for this.

I think I have an example at home somewhere, I did something like
this before.

If I get home and you still dont have a solution, I will post the code

__________________
Look! Its a ShemZilla

July 12th, 2006, 03:29 AM

nofriends

Senior Water Wizard

Join Date: Aug 2004

Location: Cape Town, RSA

Posts: 10,186

Time spent in forums: 3 Months 2 Weeks 2 Days 7 h 36 m 24 sec
Reputation Power: 699

mmm, I have the VB code, but I am also not sure how to set up
the form fields correctly in Word, but the VB code will look something like this:

Code:

''use late binding so it works on different versions of Word
Dim WrdApp As Object
Dim wrdDoc As Object
Set WrdApp = CreateObject("Word.Application")

''v_template is the word document with the form fields
Set wrdDoc = WrdApp.Documents.Add(V_Template)

''P-Field is the name of the form field in the word document
Set WrdBmrk = wrdDoc.Bookmarks(P_Field)
Set WrdRnge = WrdBmrk.Range
WrdRnge.Start = WrdBmrk.Range.Start
WrdRnge.End = WrdBmrk.Range.Start
WrdRnge.MoveStart

''InsText is the text you want to add to the form field
WrdRnge.InsertBefore Text:= InsText

hth

July 12th, 2006, 03:47 AM

jmurrayhead

Moderator

Join Date: Feb 2004

Location: Reston, VA, USA

Posts: 13,091

Time spent in forums: 3 Months 1 Week 11 h 23 m 46 sec
Reputation Power: 1580

hmm...well right now I have this:

Code:

Dim strt As String, endt As String

If Not IsNull(txtStart) Then
strt = Me.txtStart
End If
If Not IsNull(txtEnd) Then
endt = Me.txtEnd
End If

On Error GoTo the_error
    Dim objWord As Object

    Set objWord = CreateObject("Word.Application")
    objWord.Visible = False
        
    objWord.Documents.Add ("\\pathtofile\OPREP_TEMP.doc")
     
    objWord.ActiveDocument.Bookmarks("repstart").Select
    If Err.Number = 0 Then
        objWord.Selection.Text = Me.txtStart
    Else
        Err.Number = 0
    End If
             
    objWord.ActiveDocument.Bookmarks("repend").Select
    If Err.Number = 0 Then
        objWord.Selection.Text = Me.txtEnd
    Else
        Err.Number = 0
    End If
    
    Dim strSQL As String, repdat As New ADODB.Recordset
    strSQL = "SELECT * FROM globsec"
    Call get_rs(strSQL)
    Set repdat = get_rs(strSQL)
    If Not repdat.EOF Then
        objWord.ActiveDocument.Bookmarks("repinfo").Select
    If Err.Number = 0 Then
        objWord.Selection.Text = repdat("infocon").Value
    Else
        Err.Number = 0
    End If
        objWord.ActiveDocument.Bookmarks("repfp").Select
        If Err.Number = 0 Then
        objWord.Selection.Text = repdat("fpcon").Value
    Else
        Err.Number = 0
    End If
        objWord.ActiveDocument.Bookmarks("repstorm").Select
        If Err.Number = 0 Then
        objWord.Selection.Text = repdat("storm").Value
    Else
        Err.Number = 0
    End If
    End If
    
    strSQL = "SELECT * FROM facility WHERE status = 'OPEN'"
    Call get_rs(strSQL)
    Set repdat = get_rs(strSQL)
    Do While Not repdat.EOF
    objWord.ActiveDocument.Bookmarks("opfacby").Select
        If Err.Number = 0 Then
        objWord.Selection.Text = "OPENED BY: " & repdat("opened").Value
    Else
        Err.Number = 0
    End If
    objWord.ActiveDocument.Bookmarks("opfactic").Select
        If Err.Number = 0 Then
        objWord.Selection.Text = "TICKET #: " & repdat("id").Value
    Else
        Err.Number = 0
    End If
    objWord.ActiveDocument.Bookmarks("opfac").Select
        If Err.Number = 0 Then
        objWord.Selection.Text = "FACILITY: " & repdat("location").Value
    Else
        Err.Number = 0
    End If
    repdat.MoveNext
    Loop
    
    objWord.Visible = True
     
    Set objWord = Nothing
    Exit Sub
    
the_error:
    MsgBox Err.Description
Exit Sub

The way it's written now, it loops like this, for example:

Ticket#: UN010101UN010102

Where UN010101 is one record and UN010102 is another. I'm not sure how to make it space out, like I have in the attached document, between each record. I'm stuck...not sure of a better way of doing this

July 12th, 2006, 04:33 AM

sync_or_swim

Moderator

Join Date: Mar 2006

Location: South Wales

Posts: 1,932

Time spent in forums: 1 Month 6 Days 22 h 36 m 35 sec
Reputation Power: 1243

Hi JMH,

I'm sorry if this is not very slick but sometimes simplicity is the best way. I have done a similar thing in the past by creating my template in Notepad, using placeholders to designate where the information goes (denoted by pipes) and just replacing those placeholders at runtime.
template.txt:

Code:

FACILITY  TICKET #: |ticket|  TIME OF OUTTAGE: |time|
OUTTAGE: |outage|  ETR: |etr|  OPENED BY: |openedby|
|main|

The code would look something like this:

Code:

Private Sub Command1_Click()
    Dim oWord As Object
    Dim oDoc As Object

    Set oWord = CreateObject("word.application")
    Set oDoc = oWord.Documents.Add("\\pathtofile\OPREP_TEMP.doc")
    

    'header info
    Dim strt As String, endt As String
    If Not IsNull(txtStart) Then
        strt = Me.txtStart
    End If
    If Not IsNull(txtEnd) Then
        endt = Me.txtEnd
    End If
    oWord.selection.TypeText "N3 OPERATIONS REPORT FOR " & strt & " - " & endt & vbCrLf & vbCrLf
    oWord.selection.TypeText "GLOBAL SUMMARY" & vbCrLf & vbCrLf
      
    Dim strSQL As String, repdat As New ADODB.Recordset
    strSQL = "SELECT * FROM globsec"
    Call get_rs(strSQL)
    Set repdat = get_rs(strSQL)
    If Not repdat.EOF Then
        oWord.selection.TypeText "INFOCON: " & repdat("infocon") & " FPCON: " & repdat("fpcon") & " TROPICAL STORM CONDITION: " & repdat("storm").Value & vbCrLf & vbCrLf
        oWord.selection.TypeText "OPEN FACILITY INCIDENTS"
    End If
    
    strSQL = "SELECT * FROM facility WHERE status = 'OPEN'"
    Call get_rs(strSQL)
    Set repdat = get_rs(strSQL)

    'main body
    Do While Not repdat.EOF
        Open "C:/template.txt" For Input As #1
        Dim aline As String
        Line Input #1, aline
        aline = Replace(aline, "|ticket|", repdat("id").Value)
        aline = Replace(aline, "|time|", repdat("time").Value)
        oWord.selection.TypeText aline & vbCrLf
        Line Input #1, aline
        aline = Replace(aline, "|outage|", repdat("outage").Value)
        aline = Replace(aline, "|etr|", repdat("etr").Value)
        aline = Replace(aline, "|openedby|", repdat("openedby").Value)
        oWord.selection.TypeText aline & vbCrLf
        Line Input #1, aline
        aline = Replace(aline, "|main|", repdat("comments").Value)
        oWord.selection.TypeText aline & vbCrLf
        aline = ""
        Close #1
        repdat.MoveNext
    Loop
    objWord.Visible = True
     
    Set objWord = Nothing
End Sub

You could structure the template file however you wanted to. Like I said, I apologise if it is a bit of a lame suggestion!!!

Last edited by sync_or_swim : July 12th, 2006 at 04:35 AM.

July 12th, 2006, 03:24 PM

jmurrayhead

Moderator

Join Date: Feb 2004

Location: Reston, VA, USA

Posts: 13,091

Time spent in forums: 3 Months 1 Week 11 h 23 m 46 sec
Reputation Power: 1580

hmm...interesting concept...I shall try it out when I go back to work. Thanks for the suggestion!

July 18th, 2006, 09:50 PM

jmurrayhead

Moderator

Join Date: Feb 2004

Location: Reston, VA, USA

Posts: 13,091

Time spent in forums: 3 Months 1 Week 11 h 23 m 46 sec
Reputation Power: 1580

After much searching and playing around with some code, this is what I came up with and it works perfectly for me:

Code:

Dim strt As String, endt As String
Dim objWord As Word.Application
Dim doc As Word.Document
Dim bolCreated As Boolean
Dim strPath As String
Dim strSQL As String
Dim repdat_rs As New ADODB.Recordset
'Give variables form values
If Not IsNull(txtStart) Then
   strt = Me.txtStart
Else
   MsgBox "You must enter a start time.", vbOKOnly + vbCritical, "Report Error"
   Exit Sub
End If
If Not IsNull(txtEnd) Then
   endt = Me.txtEnd
Else
   MsgBox "You must enter an end time.", vbOKOnly + vbCritical, "Report Error"
   Exit Sub
End If
'Set path to document
strPath = "\\networkfolder\OPREP_TEMP.doc"
'Get Reference to Word Application
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err.Number = 429 Then
    Set objWord = CreateObject("Word.Application")
    'Set flag to indicate we created a New Word Instance
    bolCreated = True
End If
'Enable Built in Error handling
On Error GoTo 0

objWord.Visible = True
'Open Document
Set doc = objWord.Documents.Open(strPath)
     
'Set date of report
doc.bookmarks("strt").Select
objWord.Selection.TypeText strt
doc.bookmarks("dtend").Select
objWord.Selection.TypeText endt

'Build SQL string for Global Summary
strSQL = "SELECT * FROM globsec"
Call get_rs(strSQL)
Set repdat_rs = get_rs(strSQL)

'Transfer Global Summary data
doc.bookmarks("infocon").Select
objWord.Selection.TypeText repdat_rs("infocon")
doc.bookmarks("fpcon").Select
objWord.Selection.TypeText repdat_rs("fpcon")
doc.bookmarks("topstor").Select
objWord.Selection.TypeText repdat_rs("storm")

'Build SQL string for OPEN Facilities Incidents
strSQL = "SELECT * FROM facility WHERE status = 'OPEN'"
Call get_rs(strSQL)
Set repdat_rs = get_rs(strSQL)

doc.bookmarks("opfac").Select
If Not repdat_rs.EOF Then
   Do
      With objWord.Selection
      objWord.Selection.TypeText repdat_rs("location") & ": (" & repdat_rs("issue") & _
      ") TICKET #: " & repdat_rs("id") & vbCrLf & "OPENED BY: " & repdat_rs("opened") & _
      " TIME OF OUTAGE: " & UCase(Format(repdat_rs("timeout"), "ddHHnn\Z mmm yy")) & _
      vbCrLf & "SITREP/CASREP DTG: " & UCase(Format(repdat_rs("dtg"), "ddHHnn\Z mmm yy")) & _
      " ETR: " & UCase(Format(repdat_rs("etr"), "ddHHnn\Z mmm yy")) & _
      vbCrLf & "NOTES: " & repdat_rs("notes") & vbCrLf & vbCrLf
      End With
   repdat_rs.MoveNext
Loop While Not repdat_rs.EOF
Else
   objWord.Selection.TypeText "There are currently no open facility incidents."
End If

'Build SQL string for OPEN Service Level Incidents
strSQL = "SELECT * FROM servicelevel WHERE status = 'OPEN'"
Call get_rs(strSQL)
Set repdat_rs = get_rs(strSQL)

doc.bookmarks("opser").Select
If Not repdat_rs.EOF Then
   Do
      With objWord.Selection
      objWord.Selection.TypeText repdat_rs("location") & ": (" & repdat_rs("issue") & _
      ") TICKET #: " & repdat_rs("id") & vbCrLf & "OPENED BY: " & repdat_rs("opened") & _
      " TIME OF OUTAGE: " & UCase(Format(repdat_rs("timeout"), "ddHHnn\Z mmm yy")) & _
      vbCrLf & "ETR: " & UCase(Format(repdat_rs("etr"), "ddHHnn\Z mmm yy")) & _
      vbCrLf & "NOTES: " & repdat_rs("notes") & vbCrLf & vbCrLf
      End With
   repdat_rs.MoveNext
Loop While Not repdat_rs.EOF
Else
   objWord.Selection.TypeText "There are currently no open service level incidents."
End If

'Build SQL string for OPEN Unit Level Incidents
strSQL = "SELECT * FROM unitlevel WHERE status = 'OPEN' ORDER BY priority ASC"
Call get_rs(strSQL)
Set repdat_rs = get_rs(strSQL)

doc.bookmarks("opun").Select
If Not repdat_rs.EOF Then
   Do
      With objWord.Selection
      objWord.Selection.TypeText repdat_rs("location") & ": (" & repdat_rs("issue") & _
      ") TICKET #: " & repdat_rs("id") & vbCrLf & "OPENED BY: " & repdat_rs("opened") & _
      " TIME OF OUTAGE: " & UCase(Format(repdat_rs("timeout"), "ddHHnn\Z mmm yy")) & _
      " PRI: " & repdat_rs("priority") & _
      vbCrLf & "ETR: " & UCase(Format(repdat_rs("etr"), "ddHHnn\Z mmm yy")) & _
      vbCrLf & "NOTES: " & repdat_rs("notes") & vbCrLf & vbCrLf
      End With
   repdat_rs.MoveNext
Loop While Not repdat_rs.EOF
Else
   objWord.Selection.TypeText "There are currently no open service level incidents."
End If

'Build SQL string for all closed Incidents
Dim eofcount As String
eofcount = 0
strSQL = "SELECT * FROM unitlevel WHERE closetime BETWEEN #" & strt & "# AND #" & endt & "#" & _
"ORDER BY closetime ASC"
Call get_rs(strSQL)
Set repdat_rs = get_rs(strSQL)

doc.bookmarks("tclosed").Select
If Not repdat_rs.EOF Then
   Do
      With objWord.Selection
      objWord.Selection.TypeText repdat_rs("location") & ": (" & repdat_rs("issue") & _
      ") TICKET #: " & repdat_rs("id") & vbCrLf & "OPENED BY: " & repdat_rs("opened") & _
      " TIME OF OUTAGE: " & UCase(Format(repdat_rs("timeout"), "ddHHnn\Z mmm yy")) & _
      " PRI: " & repdat_rs("priority") & _
      vbCrLf & "TIME IN: " & UCase(Format(repdat_rs("timein"), "ddHHnn\Z mmm yy")) & _
      vbCrLf & "NOTES: " & repdat_rs("notes") & vbCrLf & vbCrLf
      End With
   repdat_rs.MoveNext
Loop While Not repdat_rs.EOF
Else
   eofcount = eofcount + 1
End If

strSQL = "SELECT * FROM servicelevel WHERE closetime BETWEEN #" & strt & "# AND #" & endt & "#" & _
"ORDER BY closetime ASC"
Call get_rs(strSQL)
Set repdat_rs = get_rs(strSQL)

If Not repdat_rs.EOF Then
   Do
      With objWord.Selection
      objWord.Selection.TypeText repdat_rs("location") & ": (" & repdat_rs("issue") & _
      ") TICKET #: " & repdat_rs("id") & vbCrLf & "OPENED BY: " & repdat_rs("opened") & _
      " TIME OF OUTAGE: " & UCase(Format(repdat_rs("timeout"), "ddHHnn\Z mmm yy")) & _
      vbCrLf & "TIME IN: " & UCase(Format(repdat_rs("timein"), "ddHHnn\Z mmm yy")) & _
      vbCrLf & "NOTES: " & repdat_rs("notes") & vbCrLf & vbCrLf
      End With
   repdat_rs.MoveNext
Loop While Not repdat_rs.EOF
Else
   eofcount = eofcount + 1
End If

strSQL = "SELECT * FROM facility WHERE closetime BETWEEN #" & strt & "# AND #" & endt & "#" & _
"ORDER BY closetime ASC"
Call get_rs(strSQL)
Set repdat_rs = get_rs(strSQL)

If Not repdat_rs.EOF Then
   Do
      With objWord.Selection
      objWord.Selection.TypeText repdat_rs("location") & ": (" & repdat_rs("issue") & _
      ") TICKET #: " & repdat_rs("id") & vbCrLf & "OPENED BY: " & repdat_rs("opened") & _
      " TIME OF OUTAGE: " & UCase(Format(repdat_rs("timeout"), "ddHHnn\Z mmm yy")) & _
      vbCrLf & "TIME IN: " & UCase(Format(repdat_rs("timein"), "ddHHnn\Z mmm yy")) & _
      vbCrLf & "NOTES: " & repdat_rs("notes") & vbCrLf & vbCrLf
      End With
   repdat_rs.MoveNext
Loop While Not repdat_rs.EOF
Else
   eofcount = eofcount + 1
End If

If eofcount > 2 Then
   objWord.Selection.TypeText "No incidents were closed during this time period."
   eofcount = 0
End If
'Close & release Word pointers
Set doc = Nothing
Set objWord = Nothing
Exit Sub

This uses set bookmarks in the temp Word document. There is just one thing I'm wondering about. Does anyone know of a way to prevent it wanting to save the document as the original file name (OPREP_TEMP.doc). For now I made it read-only, but I don't want users to have the choice of saving it unless they name it something different.

Comments on this post

nofriends agrees!

July 19th, 2006, 04:29 AM

nofriends

Senior Water Wizard

Join Date: Aug 2004

Location: Cape Town, RSA

Posts: 10,186

Time spent in forums: 3 Months 2 Weeks 2 Days 7 h 36 m 24 sec
Reputation Power: 699

nice one JMH, glad its working

Thread Tools	Search this Thread
Email this Page	Search this Thread: Advanced Search
Display Modes	Rate This Thread
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode	Rate This Thread: