Good afternoon,
I am having some problems with a merge that im doing from a db into word.
The merge works ok but there is after the merge there is always a copy left running.
This is my code.
Can anyone see a reason why there is still a copy running?
Thanks for your help.
I am having some problems with a merge that im doing from a db into word.
The merge works ok but there is after the merge there is always a copy left running.
This is my code.
Code:
Sub PrintContract()
''ref word
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim oDoc As Object
'''''''''''''''''''''''
Dim strSaveAs As String
Dim strPath As String
Dim strContract As String
Dim strSQL As String
Dim strPersonalID As String
Dim strFileLocation As Variant
Dim strBookingNumber As String
Dim strFolderLocation As String '''SQL Statement to insert into tblFileAttachments
Dim strFileDescription As String
Dim strComplete As String
Dim strAddress3 As String
Dim strAddress4 As String
Dim strFolderName As String
Dim strLocation As String
Dim strMyFolder As String
'''Need to chane value if address line 3 & 4 are null
If IsNull(Forms![frmMain]![txtAddress4]) Then strAddress4 = ""
If IsNull(Forms![frmMain]![txtAddress3]) Then strAddress3 = ""
Debug.Print Forms![frmMain]![txtAddress4].Value
Debug.Print strAddress4
If IsNull(Forms![frmMain]![fsubBookingDetails].Form![txtJobTitle]) Then
MsgBox ("You need to have a JOB TITLE to run contract"), vbInformation, "Missing Information"
Forms![frmMain]![fsubBookingDetails].Form![txtJobTitle].SetFocus
Forms![frmMain]![fsubBookingDetails].Form![chkContractSent].Value = 0
End If
If IsNull(Forms![frmMain]![fsubBookingDetails].Form![txtBookingNumber]) Then
MsgBox ("You need to have a BOOKING NUMBER to run contract"), vbInformation, "Missing Information"
Forms![frmMain]![fsubBookingDetails].Form![txtBookingNumber].SetFocus
Forms![frmMain]![fsubBookingDetails].Form![txtBookingNumber].Value = 0
End If
'''''''''''''''''''''''curPayRate
If IsNull(Forms![frmMain]![fsubBookingDetails].Form![curPayRate]) Then
MsgBox ("You need to have a PAY RATE to run contract"), vbInformation, "Missing Information"
Forms![frmMain]![fsubBookingDetails].Form![curPayRate].SetFocus
Forms![frmMain]![fsubBookingDetails].Form![txtBookingNumber].Value = 0
End If
''Also need to ensure the payrate is not £0
If (Forms![frmMain]![fsubBookingDetails].Form![curPayRate]) = "0" Then
MsgBox ("Sorry but a temp cant be paid £0 per hour"), vbInformation, "Missing Information"
Forms![frmMain]![fsubBookingDetails].Form![curPayRate].SetFocus
Forms![frmMain]![fsubBookingDetails].Form![txtBookingNumber].Value = 0
End If
'''''''''dtmStartDate
If IsNull(Forms![frmMain]![fsubBookingDetails].Form![dtmStartDate]) Then
MsgBox ("You need to have a START DATE to run contract"), vbInformation, "Missing Information"
Forms![frmMain]![fsubBookingDetails].Form![dtmStartDate].SetFocus
Forms![frmMain]![fsubBookingDetails].Form![txtBookingNumber].Value = 0
End If
'''''''''
If IsNull(Forms![frmMain]![txtAddress1]) Then
MsgBox ("You need to have an Address1 to run contract"), vbInformation, "Missing Information"
Forms![frmMain]![txtAddress1].SetFocus
Forms![frmMain]![fsubBookingDetails].Form![txtBookingNumber].Value = 0
End If
If IsNull(Forms![frmMain]![txtAddress2]) Then
MsgBox ("You need to have an Address2 to run contract"), vbInformation, "Missing Information"
Forms![frmMain]![txtAddress2].SetFocus
Forms![frmMain]![fsubBookingDetails].Form![txtBookingNumber].Value = 0
End If
If IsNull(Forms![frmMain]![txtPostCode]) Then
MsgBox ("You need to have a POSTCODE to run contract"), vbInformation, "Missing Information"
Forms![frmMain]![txtPostCode].SetFocus
Forms![frmMain]![fsubBookingDetails].Form![txtBookingNumber].Value = 0
End If
''''autocompletes txtdate
If Forms![frmMain]![fsubBookingDetails].Form![chkContractSent].Value = -1 Then
Forms![frmMain]![fsubBookingDetails].Form![chkContractSent].Value = Date
End If
strFileLocation = "Main Folder"
strLocation = "G:\Temp Information\"
strFolderName = CStr([txtTempName])
strMyFolder = strLocation & strFolderName
If Dir(strMyFolder, vbDirectory) = "" Then
MkDir (strMyFolder)
End If
strBookingNumber = Forms![frmMain]![fsubBookingDetails].Form![txtBookingNumber]
strBookingNumber = Forms![frmMain]![fsubBookingDetails].Form![PersonalID]
strPath = "G:\Temp Information\"
strSaveAs = Forms![frmMain]![txtTempName] & " " & Format$(Date, "dd mmm yy") & "\"
strContract = "Contract" & " " & Format$(Date, "dd_mmm_yy") & ".doc"
strComplete = strPath & strSaveAs & strContract
''Before starting code need to check for null values
Set objWord = CreateObject("word.application")
''''path of word template
Set oDoc = objWord.Documents.Add("G:\CTRDD\Templates\contract.doc")
''''show the document
objWord.Visible = False
On Error GoTo ErrorTrap
strFileDescription = "Contract" & strBookingNumber
DoCmd.Hourglass True
''''''''''''''''''''''''''''''''''PART 2
''''''''''''''''''''''''''''''''''''''''
''''''''''''''
' On Error Resume Next ''''use this in case any of the address boxes are null
oDoc.Bookmarks("address1").Select
objWord.Selection.Text = Forms![frmMain]![txtAddress1]
oDoc.Bookmarks("address2").Select
objWord.Selection.Text = Forms![frmMain]![txtAddress2]
oDoc.Bookmarks("address3").Select
objWord.Selection.Text = strAddress3
oDoc.Bookmarks("address4").Select
objWord.Selection.Text = strAddress4
oDoc.Bookmarks("PostCode").Select
objWord.Selection.Text = Forms![frmMain]![txtPostCode]
oDoc.Bookmarks("Jobtitle").Select
objWord.Selection.Text = Forms![frmMain]![fsubBookingDetails].Form![txtJobTitle]
oDoc.Bookmarks("Name").Select
objWord.Selection.Text = Forms![frmMain]![txtTempName]
oDoc.Bookmarks("StartDate").Select
objWord.Selection.Text = Forms![frmMain]![fsubBookingDetails].Form![dtmStartDate]
oDoc.Bookmarks("PayRate").Select
objWord.Selection.Text = CStr(Format(Forms![frmMain]![fsubBookingDetails].Form![curPayRate], "£###.00"))
oDoc.Bookmarks("Today").Select
'objWord.Selection.Text = CStr(Now("dd/mm/yy"))
objWord.Selection.Text = Date
objWord.Visible = False
objWord.PrintOut , , , , , , , 2
'objWord.PrintOut
MsgBox "2 Copies of the contract have now been printed", vbInformation, "Contract Printed"
'oDoc.SaveAs ("G:\Temp Information\" & strSaveAs & strContract)
''''Update tblFileAttachments & create auto link
strFileLocation = ("G:\Temp Information\" & strSaveAs & strContract)
strSQL = "INSERT INTO tblFileAttachments (PersonalID,FileLocation,FileDescription) VALUES ('" & strPersonalID & "','" & strFileDescription & "','" & strFileLocation & "')"
CurrentDb.Execute strSQL
objWord.Quit
Set objWord = Nothing
Set oDoc = Nothing
DoCmd.Hourglass False
Exit Sub
ErrorTrap:
DoCmd.Hourglass False
MsgBox Err.Number & ":-" & vbCrLf & Err.Description
Set objWord = Nothing
Set oDoc = Nothing
End Sub
Can anyone see a reason why there is still a copy running?
Thanks for your help.