B
bilbo+
At the moment i use the following code to simply export some data from my
access form to my word template and fil lthe appropriate gaps...
e.g.
doc.Bookmarks("JobNo").Select
objWord.Selection.TypeText Forms!Mjobs!("JobNo")
what i want to do now is that if there is a checkbox (of which there will be
15) that has a "yes" tick then access will send a specific paragraph of text
to the word document. The reson for this is that at the moment i am sending
customer info to the word docu ment, now i want to select the 'items' in
access using checkboxs and this will export specific spec data to the word
document. The question is what code do i have to use for this and where can i
store the specification data? in the code or elsewhere?
Thanks in advance,
William Kingston
P.S. here is the entire code -
Option Compare Database
Public Function fProcedure()
Dim objWord As Word.Application
Dim doc As Word.Document
Dim bolOpenedWord As Boolean
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set objWord = CreateObject("Word.Application")
bolOpenedWord = True
End If
objWord.Visible = True
On Error GoTo 0
strPath = CurrentDb().Name
Do
lngInStr = InStr(lngInStr + 1, strPath, "\")
Loop While (InStr(lngInStr + 1, strPath, "\") <> 0)
strPath = Left(strPath, lngInStr)
strPath = strPath & "quotetemplate.dot"
Set doc = objWord.Documents.Add(strPath)
doc.Bookmarks("JobNo").Select
objWord.Selection.TypeText Forms!Mjobs!("JobNo")
doc.Bookmarks("Firstname").Select
objWord.Selection.TypeText Forms!Mjobs!("FirstName")
doc.Bookmarks("Lastname").Select
objWord.Selection.TypeText Forms!Mjobs!("LastName")
doc.Bookmarks("Company").Select
objWord.Selection.TypeText Forms!Mjobs!("CompanyName")
doc.Bookmarks("Hiredays").Select
objWord.Selection.TypeText Forms!Mjobs!("Days")
doc.Bookmarks("User").Select
objWord.Selection.TypeText CurrentUser()
If objWord.ActiveWindow.View.SplitSpecial = wdPaneNone Then
objWord.ActiveWindow.ActivePane.View.Type = wdPrintView
Else
objWord.ActiveWindow.View.Type = wdPrintView
End If
objWord.Activate
On Error Resume Next
strPathFolder = "\\Server\CKS Database\CKS\Data\" & Forms!Mjobs!("JobNo")
If Len(Dir(strPath, vbDirectory)) = 0 Then
MkDir (strPathFolder)
MkDir (strPathFolder & "\Services")
MkDir (strPathFolder & "\Drawings")
MkDir (strPathFolder & "\Invoices")
MkDir (strPathFolder & "\Sales")
MkDir (strPathFolder & "\Suppliers")
MkDir (strPathFolder & "\Emails")
MkDir (strPathFolder & "\Emails\PKL")
MkDir (strPathFolder & "\Emails\Client")
MkDir (strPathFolder & "\Emails\Misc")
End If
strPathData = "\\Server\CKS Database\CKS\Data\" & Forms!Mjobs!("JobNo")
strPathDataFilename = "\" & "Quote 01." & Forms!Mjobs!("JobNo") & "." &
CurrentUser() & "." & Format(Date, "mm.yyyy") & ".doc"
If Dir(strPathData & strPathDataFilename) = "" Then
doc.SaveAs FileName:=strPathData & strPathDataFilename
Else
overwrite = MsgBox(prompt:=strPathData & strPathDataFilename & " already
exists, " & _
"would you like to overwrite", buttons:=vbOKCancel)
If overwrite = vbOK Then
doc.SaveAs FileName:=strPathData & strPathDataFilename
End If
End If
On Error GoTo 0
doc.Close False
Set doc = Nothing
If bolOpenedWord = True Then
objWord.Quit
End If
Set objWord = Nothing
End Function
access form to my word template and fil lthe appropriate gaps...
e.g.
doc.Bookmarks("JobNo").Select
objWord.Selection.TypeText Forms!Mjobs!("JobNo")
what i want to do now is that if there is a checkbox (of which there will be
15) that has a "yes" tick then access will send a specific paragraph of text
to the word document. The reson for this is that at the moment i am sending
customer info to the word docu ment, now i want to select the 'items' in
access using checkboxs and this will export specific spec data to the word
document. The question is what code do i have to use for this and where can i
store the specification data? in the code or elsewhere?
Thanks in advance,
William Kingston
P.S. here is the entire code -
Option Compare Database
Public Function fProcedure()
Dim objWord As Word.Application
Dim doc As Word.Document
Dim bolOpenedWord As Boolean
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set objWord = CreateObject("Word.Application")
bolOpenedWord = True
End If
objWord.Visible = True
On Error GoTo 0
strPath = CurrentDb().Name
Do
lngInStr = InStr(lngInStr + 1, strPath, "\")
Loop While (InStr(lngInStr + 1, strPath, "\") <> 0)
strPath = Left(strPath, lngInStr)
strPath = strPath & "quotetemplate.dot"
Set doc = objWord.Documents.Add(strPath)
doc.Bookmarks("JobNo").Select
objWord.Selection.TypeText Forms!Mjobs!("JobNo")
doc.Bookmarks("Firstname").Select
objWord.Selection.TypeText Forms!Mjobs!("FirstName")
doc.Bookmarks("Lastname").Select
objWord.Selection.TypeText Forms!Mjobs!("LastName")
doc.Bookmarks("Company").Select
objWord.Selection.TypeText Forms!Mjobs!("CompanyName")
doc.Bookmarks("Hiredays").Select
objWord.Selection.TypeText Forms!Mjobs!("Days")
doc.Bookmarks("User").Select
objWord.Selection.TypeText CurrentUser()
If objWord.ActiveWindow.View.SplitSpecial = wdPaneNone Then
objWord.ActiveWindow.ActivePane.View.Type = wdPrintView
Else
objWord.ActiveWindow.View.Type = wdPrintView
End If
objWord.Activate
On Error Resume Next
strPathFolder = "\\Server\CKS Database\CKS\Data\" & Forms!Mjobs!("JobNo")
If Len(Dir(strPath, vbDirectory)) = 0 Then
MkDir (strPathFolder)
MkDir (strPathFolder & "\Services")
MkDir (strPathFolder & "\Drawings")
MkDir (strPathFolder & "\Invoices")
MkDir (strPathFolder & "\Sales")
MkDir (strPathFolder & "\Suppliers")
MkDir (strPathFolder & "\Emails")
MkDir (strPathFolder & "\Emails\PKL")
MkDir (strPathFolder & "\Emails\Client")
MkDir (strPathFolder & "\Emails\Misc")
End If
strPathData = "\\Server\CKS Database\CKS\Data\" & Forms!Mjobs!("JobNo")
strPathDataFilename = "\" & "Quote 01." & Forms!Mjobs!("JobNo") & "." &
CurrentUser() & "." & Format(Date, "mm.yyyy") & ".doc"
If Dir(strPathData & strPathDataFilename) = "" Then
doc.SaveAs FileName:=strPathData & strPathDataFilename
Else
overwrite = MsgBox(prompt:=strPathData & strPathDataFilename & " already
exists, " & _
"would you like to overwrite", buttons:=vbOKCancel)
If overwrite = vbOK Then
doc.SaveAs FileName:=strPathData & strPathDataFilename
End If
End If
On Error GoTo 0
doc.Close False
Set doc = Nothing
If bolOpenedWord = True Then
objWord.Quit
End If
Set objWord = Nothing
End Function