I currently am modifying someone elses database. This is what exists now.
1) There is a button on a form that runs a macro.
2) The Macro runs a query that exports the results to an excel file.
3) The user then goes to a Mail merge word template and opens it and is prompted to run a query that grabs the data from the excel file to merge it into the document.
4) The user Copies the mail merged document into the body of the email and looks up the email address in the above excel file and sends the email.
I am trying automate the whole process to where it sends the email to the users draft folder. I found a solution that I am trying to modify to our needs. I posted a link to what I have found below.
The difference in this is I don't want to choose an email address or a file name or the title. I want to get the address from the excel file and the name of the file is always the same and so will the title of the email. So there is one button click.
Since the mail merge is already created on button click I am thinking the tasks that I need to add are:
1) Open the word doc and click yes to run the merge.
2) Copy the doc into email drafts with email address and subject included.
Here is the code I have so far. It is not yet working but I think I am on the right track.
A little newer at the coding thing so any suggestions are appreciated.
Option Compare Database
' Set Constants
Const WORD_TEMPLATE = "C:\Documents and Settings\kmoyer\Desktop\McDonalds\POSS Mail Merge.Doc"
Const POSS_DIR = "C:\Documents and Settings\kmoyer\Desktop\McDonalds"
Const DEFAULT_EMAIL = "kmoyer@LPL.com"
Private Sub Cmd_EmailPoss_Click()
' Runs Macro that runs a query to Export data to excel file which holds Client ifo for merge.
On Error GoTo Err_Cmd_EmailPOSS_Click
Dim stDocName As String
stDocName = "mcr_Export Letter POSS"
Dim sFile As String
Dim i As Integer
Dim itm As Object
Dim ID As String
Dim wd As Word.Application
Dim Doc As Word.Document
Dim objApp As Outlook.Application
Dim l_Msg As MailItem
Dim oReceipt As Outlook.Recipient
' Open file
sFile = WORD_TEMPLATE
sFile = "C:\Documents and Settings\kmoyer\Desktop\McDonalds\POSS Mail Merge.Doc"
Set wordapp = CreateObject("Word.Application")
'Open template document
wordapp.Visible = True
Set wordapp = Nothing
'Copy to outlook
'get email address record set
Set rs = CurrentDb.OpenRecordset("SELECT [Email] FROM _
"C:\Documents and Settings\kmoyer\Desktop\McDonalds\Export Records_POSS.xls ", dbOpenSnapshot, dbSeeChanges)" & _
[censored] = " Client Name" ' Set title.
' Display message, title
sSubject = ("Client Name", [censored])
Set rs = Nothing
sFile = C:\Documents and Settings\kmoyer\Desktop\McDonalds\POSS Mail Merge.Doc
Set wd = CreateObject("Word.Application")
Set Doc = wd.Documents.Open(FileName:=sFile, ReadOnly:=True)
Set itm = Doc.MailEnvelope.Item
.To = DEFAULT_EMAIL
.Subject = sSubject
ID = .EntryID
Set itm = Nothing
Set Doc = Nothing
Set wd = Nothing
' start email and get saved item
Set objApp = CreateObject("Outlook.Application")
Set l_Msg = objApp.GetNamespace("MAPI").GetItemFromID(ID)
'Loop over recipients
Do While Not rs.EOF
Set oReceipt = .Recipients.Add(rs.Fields("Email"))
oReceipt.Type = olCC
Set rs = Nothing
Set oReceipt = Nothing
Set l_Msg = Nothing
Set objApp = Nothing