Ok The following code works for one record but when there is multiple records in the query I get and error saying: Item has been moved or deleted.
help please.
----------------------------------------
Dim rst As DAO.Recordset
Dim qdf As QueryDef
Dim prm As DAO.Parameter
Dim objword As Word.Application
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set qdf = CodeDb.QueryDefs("Telstra11_GWIP_SCHOOL_LETTER")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset()
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Set objword = New Word.Application
Do Until rst.EOF
With objword
.Visible = False
.Documents.add Template:=("T:\Projects\2002 Broadband Project Implementation\Implementation Database(backup)\Telstra11 School letter.dot")
.Selection.Goto Name:="Principal"
.Selection.TypeText Text:=rst![principal name]
.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:="principal1"
.Selection.TypeText Text:=rst![principal name]
.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 MailOutLook
.to = rst![E-mail]
.Subject = "BroadBand Upgrade Project"
.BodyFormat = olFormatPlain
.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
Some people make things happen, some watch while things happen, and some wonder 'What happened?'