Can anyone tell me why my code doesn't work?
Just a run down on the code. It opens a word template and export data from a query and saves the word doco to my C drive. It then emails the word doco.
This works well with once record in the query. But, If I have moew than one record it will sen the first email and save the second word doco but gives me an error record moved or deleted.
I was assuming there was something wrong with the loop but if I take out the code for the email and run it for multiple records the word doco part words.
Could it have something to do with SP2?
My code
--------------------------------------------------
Dim rst As DAO.Recordset
Dim qdf As QueryDef
Dim prm As DAO.Parameter
Dim objword As Word.Application
Dim oOutlook As Outlook.Application
Dim oMessage As Outlook.MailItem
Set qdf = CodeDb.QueryDefs("Queryname")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset()
Set objword = Word.Application
Set oOutlook = CreateObject("Outlook.Application")
Set oMessage = oOutlook.CreateItem(olMailItem)
Do Until rst.EOF
With objword
.Visible = False
.Documents.add Template:=("C:\letter.dot")
.Selection.Goto Name:="facility_Name"
.Selection.TypeText Text:=rst![Facility name]
.Selection.Goto Name:="Address"
.Selection.TypeText Text:=rst![Address]
.Selection.Goto Name:="suburb"
.Selection.TypeText Text:=rst![SUBURB]
.Selection.Goto Name:="postcode"
.Selection.TypeText Text:=rst![POSTCODE]
.Selection.Goto Name:="project_Manager"
.Selection.TypeText Text:=rst![Project Manager]
.Selection.Goto Name:="pm_phone"
.Selection.TypeText Text:=rst![pm_phone]
.Selection.Goto Name:="pm_fax"
.Selection.TypeText Text:=rst![pm_fax]
.Selection.Goto Name:="pm_email"
.Selection.TypeText Text:=rst![pm_email]
.ActiveDocument.SaveAs ("C:\Letters\" & rst![Facility name] & " Broadband service letter.doc")
.ActiveDocument.close
End With
With oMessage
.Importance = olImportanceHigh
.to = rst![E-mail]
.Subject = "Broadband Upgrade Project"
.Body = "Dear " & rst![principal name] & ", " & vbCrLf & vbCrLf & _
"Please find attached information regarding a potential upgrade of your existing Wide Area Network service." _
& vbCrLf & vbCrLf & "Attached is a covering letter in word format detailing the new service." _
& vbCrLf & "At this stage we are planning on conducting a survey at your site " _
& rst![Forecast 1st DET Site Survey date] & ". This will be carried out by " & rst![DET 1st survey vendor] & ". " _
& vbCrLf & vbCrLf & "I will be in cotact if this date changes." _
& vbCrLf & vbCrLf & "Kind Regards." _
& vbCrLf & vbCrLf & rst![Project Manager] _
& vbCrLf & vbCrLf & "Phone: " & rst![pm_phone] _
& vbCrLf & "Fax: " & rst![pm_fax] & vbCrLf & "Email: " & rst![pm_email]
.Attachments.add "C:\Letters\" & rst![Facility name] & " Broadband service letter.doc", _
olByValue, 1, rst![Facility name] & " Broadband service letter"
.Send
End With
rst.MoveNext
Loop
Just a run down on the code. It opens a word template and export data from a query and saves the word doco to my C drive. It then emails the word doco.
This works well with once record in the query. But, If I have moew than one record it will sen the first email and save the second word doco but gives me an error record moved or deleted.
I was assuming there was something wrong with the loop but if I take out the code for the email and run it for multiple records the word doco part words.
Could it have something to do with SP2?
My code
--------------------------------------------------
Dim rst As DAO.Recordset
Dim qdf As QueryDef
Dim prm As DAO.Parameter
Dim objword As Word.Application
Dim oOutlook As Outlook.Application
Dim oMessage As Outlook.MailItem
Set qdf = CodeDb.QueryDefs("Queryname")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset()
Set objword = Word.Application
Set oOutlook = CreateObject("Outlook.Application")
Set oMessage = oOutlook.CreateItem(olMailItem)
Do Until rst.EOF
With objword
.Visible = False
.Documents.add Template:=("C:\letter.dot")
.Selection.Goto Name:="facility_Name"
.Selection.TypeText Text:=rst![Facility name]
.Selection.Goto Name:="Address"
.Selection.TypeText Text:=rst![Address]
.Selection.Goto Name:="suburb"
.Selection.TypeText Text:=rst![SUBURB]
.Selection.Goto Name:="postcode"
.Selection.TypeText Text:=rst![POSTCODE]
.Selection.Goto Name:="project_Manager"
.Selection.TypeText Text:=rst![Project Manager]
.Selection.Goto Name:="pm_phone"
.Selection.TypeText Text:=rst![pm_phone]
.Selection.Goto Name:="pm_fax"
.Selection.TypeText Text:=rst![pm_fax]
.Selection.Goto Name:="pm_email"
.Selection.TypeText Text:=rst![pm_email]
.ActiveDocument.SaveAs ("C:\Letters\" & rst![Facility name] & " Broadband service letter.doc")
.ActiveDocument.close
End With
With oMessage
.Importance = olImportanceHigh
.to = rst![E-mail]
.Subject = "Broadband Upgrade Project"
.Body = "Dear " & rst![principal name] & ", " & vbCrLf & vbCrLf & _
"Please find attached information regarding a potential upgrade of your existing Wide Area Network service." _
& vbCrLf & vbCrLf & "Attached is a covering letter in word format detailing the new service." _
& vbCrLf & "At this stage we are planning on conducting a survey at your site " _
& rst![Forecast 1st DET Site Survey date] & ". This will be carried out by " & rst![DET 1st survey vendor] & ". " _
& vbCrLf & vbCrLf & "I will be in cotact if this date changes." _
& vbCrLf & vbCrLf & "Kind Regards." _
& vbCrLf & vbCrLf & rst![Project Manager] _
& vbCrLf & vbCrLf & "Phone: " & rst![pm_phone] _
& vbCrLf & "Fax: " & rst![pm_fax] & vbCrLf & "Email: " & rst![pm_email]
.Attachments.add "C:\Letters\" & rst![Facility name] & " Broadband service letter.doc", _
olByValue, 1, rst![Facility name] & " Broadband service letter"
.Send
End With
rst.MoveNext
Loop
