Mail Merge (Kind of) HTML Dynamic email and attachment

[mdvr613]

Good morning & evening Ladies and Gents,

I've been requested to build a access DB to manage a email process. Through various searches, articles I've created the below, I'm not by any means a Developer, just a basic access user that reads a lot and like to help out. I've tried mailmerge, but decided to go with textboxes and bookmarks in the word document (easier in my opinion).

This forum has always been a source of guidance, but I wasn't able to find the solution in a single source that could complete the following they requested:

• From specific query define items to email
• Complete word document with X information
• Save document as "client field" on record/query
• Generate a dynamic email which will add client name and a date within the body of email per record
• Attach created form to respective email
• Update database records with "mail date"

So the crazy code below does all that, but..... I need help. I need to save the record to my desktop (generic) and I also need to delete the record off my desktop within the loop.

Furthermore, I think I'm missing a line of code to close word at the end of the loop :banghead:

Any help and quidance would be greatly appreciated as I think this code may help many trying to accomplish what I have (any feedback or suggestions to clean it up is also greatly appreciated)

One more thing, it does work as it is now.

Private Sub Email_Click()
 
Dim appOutLook As Object
Dim MailOutLook As Object
Dim ans As String
Dim rst As Recordset
Dim db As Database
Dim TempID As Integer
Dim Msg As String
Dim Message2 As String
Dim appword As Word.Application
Dim doc As Word.Document
Dim Path As String
 
 
Set db = CurrentDb()
  'Set rst = db.OpenRecordset("Qry_G1 email", dbOpenDynaset)
  Set rst = db.OpenRecordset("SELECT * FROM [Qry_G1 email]")
 
 
'    Me.Refresh
'    If Me.As_of_Date = 0 Then
'    ans = MsgBox("Are you sure you want to exit without completing the X? This will delete the unfinished record.", vbYesNo, " ")
'    If ans = vbYes Then
 
  'TempID = Nz(Me.ID, 0)
  rst.MoveFirst
  Do Until rst.EOF 'Or Rst.Fields(0) = TempID
'      If rst.Fields(0) = TempID Then
          With rst
 
 
 
On Error Resume Next
Error.Clear
Path = "C:\Users\x\Desktop\TIA Form G-1.docx"
Set appword = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set appword = New Word.Application
appword.Visible = False
End If
Set doc = appword.Documents.Open(Path, , True)
With doc
.FormFields("ClientEmail").Result = rst![Client Email]
.FormFields("ClientName").Result = rst![Client Name]
.FormFields("ClientName2").Result = rst![Client Name]
.FormFields("AsOfDate").Result = rst![As of Date]
.FormFields("AsOfDate2").Result = rst![As of Date]
 
 
'appword.visable = False
'appword.Activate
‘I need help here to save on desktop
appword.ActiveDocument.SaveAs2 (rst![Client Name]), (docx)
‘I need help here to save on desktop
End With
 
Set doc = Nothing
Set appword = Nothing
 
 
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
 
With MailOutLook
 
        'set the recipient list
        .To = rst![Client Email]
 
        'set the subject
        .Subject = "Test"
 
        'set the body text
        BodyFormat = olFormatHTML
 
       .HTMLBody = "<font face=Arial>Dear, " & rst![Client Name] & "" _
        & " <p> </p> " _
        & " </p>We are in the process of conducting an X of any Y concerning our continued eligibility and qualification to act as Z for the above described A issue.    In that regard, we are reviewing the necessity to transmit certain information in a X Report to the related X and Y.</p> " _
        & " <p>To assist us in our examination, kindly complete and execute the enclosed Questionnaire as of the close of business " & rst![As of Date] & ", and return it to the e-mail address below.</p> " _
        & " <p> </p> " _
        & " <p>Your prompt attention to these matters will be greatly appreciated. </p> " _
        & " <p> </p> " _
        & " <p> </p> " _
        & " <p>Sincerely,</p> " _
        & " <p> </p> " _
        & " <p> </p> " _
    & " <p>John Doe</p> " _
    & " <p>X Manager</p> " _
    & " <p>(555) 555 - 5555</p> " _
    & " <p>myemail@x.com</p> " _
    & " <p> </p> " _
    & " <p>Attachments</p> " _
    & " <p> </p> " _
    & " <p>Form G</p> " _
 
 
       '.Display
 
        'add the form created
 
        .Attachments.Add "\\Z$\" & rst![Client Name] & ".docx"
 
 
        'send the email
        .Send
 
 
        rst.Edit
        rst("Mail Date") = Now()
        rst.Update
        'rst.MoveNext
 
 
 
 
        End With
 
 
   'Clean up
 
   'Get rid of our object references
    Set appOutLook = Nothing
    Set MailOutLook = Nothing
 
 
              End With
          Me.Refresh
 
 
      rst.MoveNext
        Loop
 
    If Not (rst Is Nothing) Then
        rst.Close
        Set rst = Nothing
        Set db = Nothing
    End If
 
    'rst Close
    'MyDB.Close
    Set rst = Nothing
    Set MyDB = Nothing
    Close
 
   MsgBox "Done sending email. ", vbInformation, "Done"
 
 
End Sub

 

[mdvr613]

Since the code works, all I really want to know (at this point) is how to:

• Close the word application (even after I close the db I can't manually delete the doc created)
• How to automaticly delete each form after the email is sent

Can't figure out how to save to a specific folder, but they can live with that.

Any assistance is greatly appreciated

 

[gerry@docshop.ie]

Hi,

To save to a specific folder prefix the filename with the destination folder "d:\mydocs\filename.doc"


appword.ActiveDocument.SaveAs2 FileName:="path and filename.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=True, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False, CompatibilityMode:=15


To close the word application
place the lines

Appword.ActiveDocument.Close
appword.quit False (close without a save prompt)


before

set appword=nothing