Here is a function I use, and it works fine.
You really should define bookmarks in a Word template, like: name,
address, zip code, city etc.
Now, in the form you should call this function by:
Private Sub cmdMergeWithWor d_Click()
On Error GoTo Err_FW
Dim strM As String
strM = DLookup("[LetterPat]", "tblFirmaIn fo", "[FirmaID] = 1")
MakeAWordDoc strM
Exit_FW:
Exit Sub
Err_FW:
MsgBox Err.Number & " " & "CUSTOMER/FW" & Chr(13) _
& Err.Description , vbOKOnly
Resume Exit_FW
End Sub
Here is the function(In it's own module):
Public Function MakeAWordDoc(By Val strFile as String)
On Error Resume Next
Dim dbMTW As DAO.Database
Dim rsMTW As DAO.Recordset
Dim strKUNUM, strKUNAVN, strKUADRESS, strPNR, strSTD, strVR As String
Dim Wordobj As Word.Applicatio n
strKUNUM = DLookup("[Custnr]", "tblCustome r", "[CustID] = " &
Forms!frmCustom er!CustID)
strKUNAVN = UCase(DLookup("[AName]", "tblCustome r", "[CustID] = " &
Forms!frmCustom er!CustID))
strKUADRESS = UCase(DLookup("[Adress]", "tblustomer ", "[CustID] = " &
Forms!frmCustom er!CustID))
strPNR = DLookup("[Postnr]", "tblPostnr" , "[PostnrID] = " &
Forms!frmCustom er!PostnrID)
strSTD = DLookup("[Sted]", "tblPostnr" , "[PostnrID] = " &
Forms!frmCustom er!PostnrID)
strVR = DLookup("[VaarRef]", "tblFirmaIn fo", "[FirmaID] = 1")
Set dbMTW = CurrentDb()
Set rsMTW = dbMTW.OpenRecor dset("tblCustom er", dbOpenTable)
rsMTW.Index = "PrimaryKey "
rsMTW.Seek "=", Forms!frmCustom er!CustID
'If rsMTW.NoMatch Then
'MsgBox "Did not find a customer with that name!", vbOKOnly
'Exit Function
'End If
DoCmd.Hourglass True
Set Wordobj = GetObject(, "Word.Applicati on")
If Err.Number <> 0 Then
Set Wordobj = CreateObject("W ord.Application ")
End If
Wordobj.Visible = True
Wordobj.Documen ts.Add _
Template:=strFi le, _
NewTemplate:=Fa lse
Wordobj.Selecti on.GoTo what:=wdGoToBoo kmark, name:="KNR"
Wordobj.Selecti on.TypeText "K.nr.: " & strKUNUM
'UCase(rsMTW![Custnr])
Wordobj.Selecti on.GoTo what:=wdGoToBoo kmark, name:="NAVN"
Wordobj.Selecti on.TypeText strKUNAVN
'UCase(rsMTW![AName])
Wordobj.Selecti on.GoTo what:=wdGoToBoo kmark, name:="ADRESS"
Wordobj.Selecti on.TypeText strKUADRESS
'UCase(rsMTW![Adress])
Wordobj.Selecti on.GoTo what:=wdGoToBoo kmark, name:="POSTNR"
Wordobj.Selecti on.TypeText strPNR
Wordobj.Selecti on.GoTo what:=wdGoToBoo kmark, name:="STED"
Wordobj.Selecti on.TypeText UCase(strSTD)
Wordobj.Selecti on.GoTo what:=wdGoToBoo kmark, name:="DR"
Wordobj.Selecti on.TypeText "Deres ref.: " & UCase(rsMTW![Referanse])
Wordobj.Selecti on.GoTo what:=wdGoToBoo kmark, name:="VR"
Wordobj.Selecti on.TypeText "Vår ref.: " & UCase(strVR)
Wordobj.Selecti on.GoTo what:=wdGoToBoo kmark, name:="DT"
Wordobj.Selecti on.TypeText Date
DoEvents
Wordobj.Activat e
Set Wordobj = Nothing
DoCmd.Hourglass False
Exit Function
TemplateError:
Set Wordobj = Nothing
Exit Function
End Function
BerkshireGuy skrev:
I want to open a word document from an Access form and transfer data
from the Access form to the Word Document.
For instance, if a user clicks an option box on my access form, I want
to pass certain data to the next new line of a opened word doc.
Here is what I tried, but doesnt seem to work:
Dim objWord As Object
Dim NewRow As Row
Set objWord = CreateObject("W ord.Application ")
objWord.Visible = True
objWord.Documen ts.Open "U:\May 6.doc"
Set NewRow = objWord.Tables( 1).Rows.Add
With NewRow
.Cells(1).Range .Text = Format(Now(), "HH:MM") & " " & "HRS PD"
.Cells(2).Range .Text = "Police on property at this time."
End With
Thanks,
Brian
