Word export

[Guest]

I've gotten this work by referencing the object model, but that caused other
problems in my database and this is the only place where I use this. What
I'm trying to do is write data from a query into a word template that I've
got set up. What seems to be happening is that it gets down to where it
needs to write the data into the word document it crashes. I think it's
because it uses Word constants, but I'm not sure. Any help would be
appriciated.

Dim dbs As Database
Dim objDocs As Object
Dim objWord As Object
Dim prps As Object
Dim rst As Recordset
Dim blnSaveNameFail As Boolean
Dim strDoc As String
Dim strDocsPath As String
Dim strSaveName As String
Dim strSaveNamePath As String
Dim strTemplatePath As String
Dim strTest As String
Dim strTestFile As String
Dim strWordTemplate As String
Dim strMessageTitle As String
Dim strMessage As String
Dim strShotID As String
Dim strRCCode As String
Dim strdescription As String
Dim strAlphaCode As String
Dim strnotes As String
Dim dteTodayDate As Date
Dim straddress_1 As String
Dim straddress_2 As String
Dim straddress_3 As String
Dim strcity As String
Dim strstate As String
Dim strzip As String
Dim strcontract As String
Dim strfullname As String
Dim strnumbertype_1 As String
Dim strnumber_1 As String
Dim strnumbertype_2 As String
Dim strnumber_2 As String
Dim fulladdress As String
Dim strphone As String

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("qryselectmodeladdressfinal", dbOpenDynaset)


Set objWord = CreateObject("Word.Application")

'Sets up error handler for the rest of the procedure
On Error GoTo cmdWordInvoice_ClickError

strWordTemplate = "T:\Templates\Model Report.dot"
strTestFile = Nz(Dir(strWordTemplate))
If strTestFile = "" Then
MsgBox strWordTemplate & " template not found; can't create letter"
Exit Sub
End If



Set objDocs = objWord.Documents.Add(strWordTemplate)
'objDocs.Add strWordTemplate


objWord.Visible = True
objWord.Activate

Set rst = dbs.OpenRecordset("qryselectmodeladdressfinal", dbOpenDynaset)

With objWord.Selection
.MoveDown Unit:=wdcell, Count:=1
End With

With rst
.MoveFirst
Do While Not .EOF
strShotID = Nz(![Master Reel Shot ID])
Debug.Print "Shot ID " & strShotID
strRCCode = Nz(![RC Code])
Debug.Print "Rights Code " & strRCCode
strAlphaCode = Nz(![alpha code])
Debug.Print "Alpha Code " & strAlphaCode
strdescription = Nz(![DESCRIPTION])
Debug.Print "Description " & strdescription
strnotes = Nz(![RC Notes])
Debug.Print "Notes " & strnotes
strfullname = Nz(![full name])
Debug.Print "Name " & strfullname
strcontract = Nz(![CONTRACT_NUMBER])
Debug.Print "Model Number " & strcontract
straddress_1 = Nz(![ADDRESS_LINE_1])
straddress_2 = Nz(![ADDRESS_LINE_2])
straddress_3 = Nz(![ADDRESS_LINE_3])
strcity = Nz(![CITY])
strstate = Nz(![STATE])
strzip = Nz(![ZIP_CITY_CODE])
straddressfull = straddress_1 & Chr(10) & straddress_2 & Chr(10) &
straddress_3 & Chr(10) & strcity & ", " & strstate & _
" " & strzip
Debug.Print "Address " & straddressfull
strnumbertype_1 = Nz(![number type 1])
strnumbertype_2 = Nz(![number type 2])
strnumber_1 = Nz(![number 1])
strnumber_2 = Nz(![number 2])
strphone = [strnumbertype_1] & " " & [strnumber_1] & Chr(10) &
[strnumbertype_2] & " " & [strnumber_2]
Debug.Print "Phone " & strphone



'Move through the table, writing values from the variables
'to cells in the Word table
With objWord.Selection
'.MoveDown Unit:=wdLine, Count:=1
.TypeText Text:=CStr(strShotID)
.MoveRight Unit:=wdcell
.TypeText Text:=strRCCode
.MoveRight Unit:=wdcell
.TypeText Text:=CStr(strAlphaCode)
.MoveRight Unit:=wdcell
.TypeText Text:=strdescription
.MoveRight Unit:=wdcell
.TypeText Text:=strnotes
.MoveRight Unit:=wdcell
.TypeText Text:=CStr(strfullname)
.MoveRight Unit:=wdcell
.TypeText Text:=strcontract
.MoveRight Unit:=wdcell
.TypeText Text:=CStr(straddressfull)
.MoveRight Unit:=wdcell
.TypeText Text:=strphone
.MoveRight Unit:=wdcell

End With
.MoveNext
Loop
.close
End With
dbs.close

'Delete last, empty row
Selection.SelectRow
Selection.Rows.Delete


cmdWordInvoice_ClickExit:
'Close any open recordset or database, in case code stops because
'of an error
On Error Resume Next
rst.close
On Error Resume Next
dbs.close
Exit Sub

cmdWordInvoice_ClickError:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.DESCRIPTION
Resume cmdWordInvoice_ClickExit


End Sub

 

[Albert D.Kallal]

I am going to suggest you get rid of all those hard coded field names.

Why not just setup a regular word template, and merge to that, no need to
define, or hard code ANY of the actual field names, and worse every time you
need word merge for another form, you will be hard coding again.

Try downloading and running my sample word merge here:
http://www.members.shaw.ca/AlbertKallal/msaccess/msaccess.html

If you like the above, then follow the instructions on how to use it....

 

[Guest]

I works great, but is there a way to put all the records on one page rather
than on seperate pages? I don't want to have the user run a second macro in
Word to eliminate all the extra information that they don't need. It would
get screwed up somehow and it's not worth the headaches explaining it over
and over again.

Thanks
Brian