How to attach Automation using word - Programmers Heaven

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

Welcome to the new platform of Programmer's Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use its exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

How to attach Automation using word

CarlettoCarletto Posts: 1Member
Dear all

I have written a vba code to open a word document and to attach some informations to this document like (date: and to:) I have saved this vba code in a new modules that I called (modstandar).

the code is working properly, if I go through it with F8 it open the word document. also it puts the date and the name of the person where this letter or document go.

My problem is that I do not know How I can attached this code to a form and open the word document and automaticaly insert the (date: 21/04/2009, To: Carlo, Text: this is a memo)

This is the code:

Option Compare Database
Option Explicit
Private objWord As Object
Private blOpenedWord As Boolean


Public Function OpenWord()
On Error GoTo Err_OpenWord
Set objWord = GetObject(, "Word.Application")
objWord.Application.Visible = True
Exit_OpenWord:
Exit Function
Err_OpenWord:

If Err = 429 Then 'word is not running
Set objWord = CreateObject("Word.Application")
blOpenedWord = True
Resume Next
Else

MsgBox "Error no. " & Err.Number
Resume Exit_OpenWord
End If
End Function

Public Function OpenNewWordDoc()

' Uses OpenWord function to open Word
' Opens new blank document

On Error GoTo Err_OpenNewWordDoc

Dim docWord As Word.Document

OpenWord
Set docWord = objWord.Documents.Add

' Insert text into the Word document

objWord.Selection.TypeText "This document was created automatically by Access"
objWord.Selection.TypeParagraph
objWord.Selection.TypeText "It will now be closed and saved"
objWord.Selection.TypeParagraph
objWord.Activate

docWord.Save
docWord.Close
Set docWord = Nothing

If blOpenedWord = True Then
objWord.Quit
End If

Set objWord = Nothing

Exit_OpenNewWordDoc:
Exit Function
Err_OpenNewWordDoc:
MsgBox "Error no. " & Err.Number
Resume Exit_OpenNewWordDoc

End Function

Public Function OpenWordDoc()
On Error GoTo Err_OpenWordDoc
Dim fname As String
Dim docWord As Word.Document
OpenWord
' file name needs to include path
' if file to open is in same folder as database can use Path attribute of current project
fname = CurrentProject.Path & "empMemo.doc"
Set docWord = objWord.Documents.Open(fname)
Exit_OpenWordDoc:

Exit Function
Err_OpenWordDoc:
MsgBox "Error no. " & Err.Number
Resume Exit_OpenWordDoc

End Function


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 made a form and I have added a command button.

What I should now to make it works.

Marco
Sign In or Register to comment.