Solved

automatically send emails with attached distinct file - email merge - MS Access

Posted on 2008-06-23
11
982 Views
Last Modified: 2013-12-20
Hi, I have an Access DB that contains a list of individuals (agents).  I also have a folder that contains Excel Spreadsheets with a file name exactly the same as the agent name in the Access DB.  What I'd like to do is to create a script that is attached to a button in the database that when clicked will grab each Excel file and automatically email it to the email address we have on file in the database.  I've found some code that will send an email but having some problems figuring out how to automate the process.  Any help is much appreciated.  Thanks.
0
Comment
Question by:divehunter
  • 7
  • 3
11 Comments
 

Author Comment

by:divehunter
ID: 21849992
I read my question and thought I should probably give an example:

1. AgentA  and AgentB are listed in the Access database with an associated email address.
2. AgentA and B also have a spreadsheet located at c:\docs\reports\ called AgentA.xls and AgentB.xls.
3. I'd like to create a button that when clicked will automatically email AgentA his spreadsheet and AgentB his spreadsheet.  

Hope this helps make it a little clearer.  Please let me know if you need any additional information or attachments.  Thanks again for your help.
0
 
LVL 4

Accepted Solution

by:
abdulhameeds earned 400 total points
ID: 21852915
my idea iam using is congure outlook mailing
then


Private Sub Email_Output_Click()
'
' Email API Outlook example programming code
' Send email from to Outlook
'


C.ShowOpen
Mail_Attachment_Path.Text = C.FileName
Select Case Me.Email_Output_Option
    Case 1
        Dim mess_body As String
        Dim rst As Recordset
        Dim appOutLook As Outlook.Application
        Dim MailOutLook As Outlook.MailItem
        Set appOutLook = CreateObject("Outlook.Application")
        Set MailOutLook = appOutLook.CreateItem(olMailItem)
'        Set rst = Form_F_People_Mailings.RecordsetClone
'        rst.MoveFirst
'        Do While Not rst.EOF
'            If IsNull(rst!Email) Then
'                MsgBox "skipping " & _
'                Form_F_People_Mailings.LastName & _
'                " no email address."
'                GoTo skip_email
'            End If
            mess_body = "Dear Mess_Text"
            Set appOutLook = CreateObject("Outlook.Application")
            Set MailOutLook = appOutLook.CreateItem(olMailItem)
            With MailOutLook
                .To = "mis1411@hotmail.com"
                    .Subject = "Mess_Subject"
                    .Body = mess_body
                    If Left(Me.Mail_Attachment_Path, 1) <> "<" Then
                        .Attachments.Add (Me.Mail_Attachment_Path)
                    End If
                    'next line would let MS Outlook API send the note
                    'without storing it in your sent bin
                    '.DeleteAfterSubmit = True
                    .Send
                End With
skip_email:
'        rst.MoveNext
'    Loop
'    rst.Close
'    Set rst = Nothing
End Select




End Sub


hope it will help you
iaam working with this idea
0
 

Author Comment

by:divehunter
ID: 21861358
Hi abdulhameeds, thanks for the info.  I tried setting it up but having problems getting it working.  Do you know if there is a method that doesn't use an email client and instead is able to send directly?  Thanks for your help.
0
 

Author Comment

by:divehunter
ID: 21861386
I found the following code online that uses cdo but I'm not sure how to integrate it with the database and add the additional functionality of attaching a specific file and sending it to a specific person.  Here's the code:

Public Function fncSendEmail(strFrom As String, strTo As String, strCC As String, strBCC As String, strSubject As String, strBodyText As String, strAttachment As String) As Boolean
       
    Dim objCDOMail As Object
   
    On Error GoTo SendEmailFailure:
       
    'Create a session
    Set objCDOMail = CreateObject("CDO.Message")

    objCDOMail.From = strFrom
    objCDOMail.To = strTo
    objCDOMail.CC = strCC
    objCDOMail.BCC = strBCC
    objCDOMail.Subject = strSubject
    objCDOMail.TextBody = strBodyText
    If strAttachment <> "" Then
       objCDOMail.AddAttachment strAttachment
    End If
       
    objCDOMail.Send
   
SendEmailFailure:
    If Err.Number <> 0 Then
        MsgBox "An error ocurred when sending an email" & vbCrLf & Err.Description, vbCritical
    End If
   
    On Error Resume Next
   
    Set objCDOMail = Nothing
End Function

Thanks again for all your help.
0
 
LVL 4

Assisted Solution

by:abdulhameeds
abdulhameeds earned 400 total points
ID: 21862968
now for the up this is the file attached but change the extenshion but first u have to configure outlook express account
change the *.txt to *.rar

this is rar file
then u can see the email


the second CDO
u have to add micro soft CDO windows 2000 library to work

but this CDO always making problems with me  insending

best regards

email-from-outloock.txt
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 4

Assisted Solution

by:abdulhameeds
abdulhameeds earned 400 total points
ID: 21863002
0
 
LVL 22

Assisted Solution

by:danaseaman
danaseaman earned 100 total points
ID: 21872071
Free Email code that doesn't rely on Outlook.

1. vbSendMail.dll Version 3.65-- Easy E-mail Sending in VB, with Attachments
    http://www.freevbcode.com/ShowCode.Asp?ID=109

2. BackMail maintains a Recipient list database.
    E-Promo(aka BackMail). Bulk e-mail sender based upon vbSendMail
    http://www.vbcode.com/Asp/showzip.asp?ZipFile=http://www.vbcode.com/code/BackMail.zip&theID=12032

Perhaps add a new field to the BackMail database with AgentA, AgentB, etc.

0
 

Author Comment

by:divehunter
ID: 21877668
Hi All,   thanks for your help.  Still working on the problem.  I tried modifying the Outlook code but afraid I don't know enough to make it work.  Basically I have a table (tbl-TransactionCommReport) and contains the following fields:  strEmail (agents email address), AgentName (agents company name), AgentContact (First & Last name of contact person for agent).  In addition I have a spreadsheet for each agent (using company name as file name) located at c:\documents and settings\all users\desktop.  What I'd like to do is have the code automatically attach the agents report (.xls) to an email addressed to the agent via code.  I'd like to have the code run through each agent name until it reaches eof.  Here's the modifications I made to the code (don't laugh).  Can anyone help me determine what I'm missing or doing wrong?  Thanks and take care.

Private Sub Email_Output_Click()
'
' Email API Outlook example programming code
' Send email from to Outlook
'


C.ShowOpen
Mail_Attachment_Path.Text = C.FileName
Select Case Me.Email_Output_Option
    Case 1
        Dim mess_body As String
        Dim rst As Recordset
        Dim appOutLook As Outlook.Application
        Dim MailOutLook As Outlook.MailItem
        Set appOutLook = CreateObject("Outlook.Application")
        Set MailOutLook = appOutLook.CreateItem(olMailItem)
'        Set rst = tbl-TransactionCommReport
'        rst.MoveFirst
'        Do While Not rst.EOF
'            If IsNull(rst!strEmail) Then
'                MsgBox "skipping " & _
'                tblTransactionCommReport.AgentName & _
'                " no email address."
'                GoTo skip_email
'            End If
            mess_body = "Dear tbl-TransactionCommReport.AgentContact"
            Set appOutLook = CreateObject("Outlook.Application")
            Set MailOutLook = appOutLook.CreateItem(olMailItem)
            With MailOutLook
                .To = "tbl-TransactionCommReport.strEmail"
                    .Subject = "Your monthly Commission Report"
                    .Body = "Attached is your monthly commission Report."
                    If Left(Me.Mail_Attachment_Path, 1) <> "<" Then
                        .Attachments.Add (Me.Mail_Attachment_Path)
                    End If
                    'next line would let MS Outlook API send the note
                    'without storing it in your sent bin
                    '.DeleteAfterSubmit = True
                    .Send
                End With
skip_email:
'        rst.MoveNext
'    Loop
'    rst.Close
'    Set rst = Nothing
End Select




End Sub
0
 

Author Comment

by:divehunter
ID: 21880177
Hi All, I ended up giving up on the code I was working on and started from scratch.  I think I just about have everything working except I'm getting an error on the filename attachment.  The error I'm getting is: error -21470248948 (80070002) Cannot find this file.  Verify the path and file name are correct.  When I go to debug, it highlights MyMail.Attachments.Add "C:\Documents and Settings\All Users\Desktop\CommReports\" & MailList("AgentName") & ".xls", olByValue, 1 as having a problem.  Here's the code I'm trying to use:

Option Compare Database

Public Function SendEMail()

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim fso As FileSystemObject

Set fso = New FileSystemObject
Subjectline$ = InputBox$("Please enter the subject for the message")

If Subjectline$ = "" Then
MsgBox "No subject line, no message. " & vbNewLine & vbNewLine & "Quitting...", vbCritical, "E-Mail Merger"
Exit Function
End If

Set MyOutlook = New Outlook.Application
Set db = CurrentDb()
Set MailList = db.OpenRecordset("tbl-TransactionCommReport")

Do Until MailList.EOF

Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.To = MailList("strEmail")
MyMail.Subject = Subjectline$
MyMail.Body = "Dear " & MailList("AgentName") & "," & vbNewLine & vbNewLine & "Attached is your most recent Commission Report.  Thank you for your continued business and support.  Please feel free to contact our billing department if you have any questions.  They can be reached at 800-267-6006." & vbNewLine & vbNewLine & "Cordially, " & vbNewLine & vbNewLine & "DataPreserve Customer Care Team"
MyMail.Attachments.Add "c:\Documents and Settings\All Users\" & MailList("AgentName") & ".xls", olByValue, 1

MyMail.Send
'MyMail.Display
MailList.MoveNext

Loop

Set MyMail = Nothing
MyOutlook.Quit
Set MyOutlook = Nothing
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing

End Function

Can anyone tell me why I get the error?  I can send you a mock up of the table that it's reading from if it would help.  Thanks in advance for all your assistance.  Please let me know if you need additional information to help me troubleshoot this.
0
 

Author Comment

by:divehunter
ID: 21881193
Ok, after a little playing around I finally got it to work without the errors.  Here's the code:
Option Compare Database

Public Function SendEMail()

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim fso As FileSystemObject

Set fso = New FileSystemObject
Subjectline$ = InputBox$("Please enter the subject for the message")

If Subjectline$ = "" Then
MsgBox "No subject line, no message. " & vbNewLine & vbNewLine & "Quitting...", vbCritical, "E-Mail Merger"
Exit Function
End If

Set MyOutlook = New Outlook.Application
Set db = CurrentDb()
Set MailList = db.OpenRecordset("tbl-TransactionCommReport")

Do Until MailList.EOF

Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.To = MailList("strEmail")
MyMail.Subject = Subjectline$
MyMail.Body = "Dear " & MailList("AgentName") & "," & vbNewLine & vbNewLine & "Attached is your most recent Commission Report.  Thank you for your continued business and support.  Please feel free to contact our billing department if you have any questions.  They can be reached at 800-267-6006." & vbNewLine & vbNewLine & "Cordially, " & vbNewLine & vbNewLine & "DataPreserve Customer Care Team"
MyMail.Attachments.Add "C:\Documents and Settings\All Users\Desktop\CommReports\" & MailList("AgentName") & ".xls", olByValue, 1

MyMail.Send
'MyMail.Display
MailList.MoveNext

Loop

Set MyMail = Nothing
MyOutlook.Quit
Set MyOutlook = Nothing
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing

End Function

I'd like to thank both of you for your help.  I did my best to be fair with the point split.  
0
 

Author Closing Comment

by:divehunter
ID: 31469927
I appreciate the quick response and fthe links that pointed me in the right direction.  The sample code really helped me to understand what I needed to do to get it working.  Thanks for your help.
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now