Solved

Send Email (Outlook 2010) from Access Table

Posted on 2014-04-03
12
691 Views
Last Modified: 2014-04-03
I need to send emails as a group from a Access table with attached Excel spreadsheet on a command button.
0
Comment
Question by:shieldsco
  • 7
  • 4
12 Comments
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 39975143
try this codes


Dim objOutlook As Object, objEmailMessage As Object
Dim sSubj As String, sBody As String, sTo As String, strCC As String
Dim xlPath as string
xlPath = "c:\folderName\myexcel.xls"


Set objOutlook = CreateObject("Outlook.Application")
Set objEmailMessage = objOutlook.CreateItem(0)

With objEmailMessage
         .To = sMail
         If strCC & "" <> "" Then
                    .CC = strCC
         End If
         .Subject = sSubj
      .Attachments.Add xlPath

      .display
      '      .send
End With


to get all the recipient emails, open the the table as recordset

dim rs as dao.recordset
set rs=currentdb.openrecordset("select email from tableName")

do until rs.eof
     sMail=sMail & ";" & rs("email")
    rs.movenext
loop

sMail=mid(sMail,2)
0
 

Author Comment

by:shieldsco
ID: 39975707
It opens Outlook and attaches file however the code does no populate the email address in Outlook
0
 

Author Comment

by:shieldsco
ID: 39975951
Email address is not populated in Outlook
0
 

Author Comment

by:shieldsco
ID: 39975965
Does the email field have to text? Currently I have it as a hyperlink
0
 

Author Comment

by:shieldsco
ID: 39975967
Below is the code

Private Sub Email_Click()


Dim objOutlook As Object, objEmailMessage As Object
Dim sSubj As String, sBody As String, sTo As String, strCC As String
Dim xlPath As String
xlPath = "\\cdc\project\OD_FMO_DEBT_MGT\PA Invoice Split Database\Email\Invoice_Email.xlsm"





Set objOutlook = CreateObject("Outlook.Application")
Set objEmailMessage = objOutlook.CreateItem(0)

With objEmailMessage
         .To = sMail
         If strCC & "" <> "" Then
                    .CC = strCC
         End If
         .Subject = sSubj
      .Attachments.Add xlPath

      .display
      '      .send
End With



Dim rs As dao.Recordset
Set rs = CurrentDb.OpenRecordset("tblStaff")

Do Until rs.EOF
     sMail = sMail & ";" & rs("email")
    rs.MoveNext
Loop

sMail = Mid(sMail, 2)




End Sub
0
Control application downtime with dependency maps

Visualize the interdependencies between application components better with Applications Manager's automated application discovery and dependency mapping feature. Resolve performance issues faster by quickly isolating problematic components.

 
LVL 119

Expert Comment

by:Rey Obrero
ID: 39976111
use this codes


Private Sub Email_Click()
Dim objOutlook As Object, objEmailMessage As Object
Dim sSubj As String, sBody As String, sTo As String, strCC As String
Dim xlPath As String
xlPath = "\\cdc\project\OD_FMO_DEBT_MGT\PA Invoice Split Database\Email\Invoice_Email.xlsm"

Dim rs As dao.Recordset
Set rs = CurrentDb.OpenRecordset("tblStaff")

Do Until rs.EOF
     sMail = sMail & ";" & rs("email")
    rs.MoveNext
Loop

sMail = Mid(sMail, 2)




Set objOutlook = CreateObject("Outlook.Application")
Set objEmailMessage = objOutlook.CreateItem(0)

With objEmailMessage
         .To = sMail
         If strCC & "" <> "" Then
                    .CC = strCC
         End If
         .Subject = sSubj
      .Attachments.Add xlPath

      .display
      '      .send
End With

End Sub


.
0
 

Author Comment

by:shieldsco
ID: 39976146
The code works fine however the TO : line in the outlook message is this format Adrianne.Thomas@va.gov#mailto: Adrianne.Thomas@va.gov# which outlook does not recognize. Any thoughts on fixing the problem
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 39976180
dim varEmail as string

Do Until rs.EOF
varEmail=rs("email")
     sMail = sMail & ";" & Left(varEmail, Instr(varEmail,"#")-1)
    rs.MoveNext
Loop

sMail = Mid(sMail, 2)
0
 

Author Comment

by:shieldsco
ID: 39976215
I get run time error 94 invalid use of null on code:
varEmail = rs("email")
0
 
LVL 119

Accepted Solution

by:
Rey Obrero earned 500 total points
ID: 39976253
dim varEmail as string

Do Until rs.EOF
  if rs("email") & ""<>"" then
       varEmail=rs("email")
           sMail = sMail & ";" & Left(varEmail, Instr(varEmail,"#")-1)
   end if
    rs.MoveNext
Loop

sMail = Mid(sMail, 2)
0
 

Author Closing Comment

by:shieldsco
ID: 39976270
Thanks for ALL YOUR HELP!!!!
0

Featured Post

What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

Question has a verified solution.

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

Suggested Solutions

Resolve DNS query failed errors for Exchange
Finding original email is quite difficult due to their duplicates. From this article, you will come to know why multiple duplicates of same emails appear and how to delete duplicate emails from Outlook securely and instantly while vital emails remai…
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

914 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

18 Experts available now in Live!

Get 1:1 Help Now