Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

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

Posted on 2008-06-23
11
Medium Priority
?
994 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 1600 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
Visualize your virtual and backup environments

Create well-organized and polished visualizations of your virtual and backup environments when planning VMware vSphere, Microsoft Hyper-V or Veeam deployments. It helps you to gain better visibility and valuable business insights.

 

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 1600 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
 
LVL 4

Assisted Solution

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

Assisted Solution

by:danaseaman
danaseaman earned 400 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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Instead of error trapping or hard-coding for non-updateable fields when using QODBC, let VBA automatically disable them when forms open. This way, users can view but not change the data. Part 1 explained how to use schema tables to do this. Part 2 h…
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…
Suggested Courses

916 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