How I can open Word document using Automation from my Access Database

[carletto]

Dear All,


I Have created the following pices of code that help me to fill the following filds (Date, TO and Text) in a word document automaticaly taking the relevant information from my database.

This is the code:

Public Function CreateWordMemo()

' Open memo in Word and insert text

On Error GoTo CreateWordMemo_Error

Dim dbs As Database
Dim rstEmployees As Recordset
Dim appWord As Word.Application
Dim docWord As Word.Document
Dim fname As String

Dim strDate As String
strDate = Date 'assign date to string variable so we can print it

OpenWord ' use function to open Word
'Open recordset based on employee name query

Set dbs = CurrentDb()

Set rstEmployees = dbs.OpenRecordset("qryEmpFullName")
' open the memo document
' assume memo document in same folder as database
fname = CurrentProject.Path & "\empMemo.doc"

Set docWord = objWord.Documents.Open(fname)
objWord.Visible = True
With objWord
.Selection.Goto wdGoToBookmark, Name:="DateToday" 'move to date bookmark

.Selection.TypeText " " & strDate 'insert date

.Selection.Goto wdGoToBookmark, Name:="MemoToLine" 'move to memo line bookmark
End With

'Loop through recordset returned by query, inserting name of each employee
Do Until rstEmployees.EOF
objWord.Selection.TypeText rstEmployees!Employee & ", "
rstEmployees.MoveNext
Loop
'reset variables to nothing and free up memory for other processes
Set rstEmployees = Nothing
Set dbs = Nothing
Set docWord = Nothing
Set objWord = Nothing
Exit_CreateWordMemo:
Exit Function
CreateWordMemo_Error: 'error trapping routine
MsgBox Err.Description
Resume Exit_CreateWordMemo
End Function

I have tested the code it works absolutely fine.

What are my problems?

1) I can not make go the word cursor automaticaly to the text after I have inserted the Date: and TO: but it carry on inserting me more users in the TO: Location.

2) Also I have to try to save and close this work.

3) Also I am NOT ABLE TO attached this pice of code to my form, I have also thoguht to insert a combo box where I can select the person I want to send the memo and to attach a command button and open this word memo Document from the form.

I have a coomand button on my form and the combo box but I can not make work the final pices to open This Word Memo in Automation.

I am looking forwqard to hearing from you.

Carletto

 

[DCrake]

Couple of suggestions:

It appears that your End With is too early in your code. You are ending your word work after moving to the memo bookmark.

Also I would generate the list of names before you try and send it to the document.

 

[DCrake]

To point you in the right direction you need to make the folllowing changes

Public Function CreateWordMemo()

' Open memo in Word and insert text

On Error GoTo CreateWordMemo_Error

Dim dbs As Database
Dim rstEmployees As Recordset
Dim appWord As Word.Application
Dim docWord As Word.Document
Dim fname As String

Dim strDate As String 
strDate = Date 'assign date to string variable so we can print it 

OpenWord ' use function to open Word 
'Open recordset based on employee name query 

Set dbs = CurrentDb() 

Set rstEmployees = dbs.OpenRecordset("qryEmpFullName") 
' open the memo document 
' assume memo document in same folder as database 
fname = CurrentProject.Path & "\empMemo.doc"

Set docWord = objWord.Documents.Open(fname) 
objWord.Visible = True 
With objWord 
.Selection.Goto wdGoToBookmark, Name:="DateToday" 'move to date bookmark 

.Selection.TypeText " " & strDate 'insert date 

.Selection.Goto wdGoToBookmark, Name:="MemoToLine" 'move to memo line bookmark 
End With 

'Loop through recordset returned by query, inserting name of each employee 
Do Until rstEmployees.EOF 
objWord.Selection.TypeText rstEmployees!Employee & ", " 
rstEmployees.MoveNext 
Loop 
'reset variables to nothing and free up memory for other processes 
Set rstEmployees = Nothing 
Set dbs = Nothing 
Set docWord = Nothing 
Set objWord = Nothing 
Exit_CreateWordMemo: 
Exit Function
CreateWordMemo_Error: 'error trapping routine 
MsgBox Err.Description 
Resume Exit_CreateWordMemo
End Function

Change to

Public Function CreateWordMemo()

' Open memo in Word and insert text

On Error GoTo CreateWordMemo_Error

Dim dbs As Database
Dim rstEmployees As Recordset
Dim appWord As Word.Application
Dim docWord As Word.Document
Dim fname As String
[B]Dim strEmployees As String[/B]

Dim strDate As String 
strDate = Date 'assign date to string variable so we can print it 

OpenWord ' use function to open Word 
'Open recordset based on employee name query 

Set dbs = CurrentDb() 

Set rstEmployees = dbs.OpenRecordset("qryEmpFullName") 


Do Until rstEmployees.EOF 
   StrEmployees = StrEmployees & rstEmployees("Employee") & ", " 
   rstEmployees.MoveNext 
Loop 

[B]StrEmployees = Left(StrEmployees,Len(StrEmployees)-2)[/B]

'reset variables to nothing and free up memory for other processes 
Set rstEmployees = Nothing 
Set dbs = Nothing 

' open the memo document 
' assume memo document in same folder as database 
fname = CurrentProject.Path & "\empMemo.doc"

Set docWord = objWord.Documents.Open(fname) 
objWord.Visible = True 
With objWord 
.Selection.Goto wdGoToBookmark, Name:="DateToday" 'move to date bookmark 

.Selection.TypeText " " & strDate 'insert date 

.Selection.Goto wdGoToBookmark, Name:="MemoToLine" 'move to memo line bookmark 

[B].Selection.TypeText " " & StrEmployees  'insert list of employees[/B] 

End With

Set docWord = Nothing 
Set objWord = Nothing 
Exit_CreateWordMemo: 
Exit Function
CreateWordMemo_Error: 'error trapping routine 
MsgBox Err.Description 
Resume Exit_CreateWordMemo
End Function

The items in bold are new lines


Regards
David