Automation Process -Outlook and Access

[amal1973]

I have a Folder that has around 300 Excel Workbooks. I also have a table in access that has the email addresses for every workbook that should be sent. Please help me develop a code that will attach the Excel File to the specific email. Ex..
Excel Workbook Name: OZ3.XLS
Access Table :
Field One :OZ3
Field Two: xxx@xx.com

Thanks a million

 

[danvlas]

Dim objOLApp As Object
Dim objMailItem As Object

Dim db As DAO.Database
Dim rstEmails As DAO.Recordset

Dim conn As ADODB.Connection
Dim rstEmails As New ADODB.Recordset

Set db = CurrentDb
Set rstEmails = db.OpenRecordset("Select * From YourTable&quot


Set conn = CurrentProject.Connection
rstEmails.Open "Select * From YourTable", conn

Set objOlApp = CreateObject("Outlook.Application&quot

With rstEmails
While Not .EOF
Set objMailItem = objOlApp.CreateItem(0)
objMailItem.To = .Fields("Field Two&quot
objMailItem.Attachments.Add "C:\Path\" & .Fields("Field One&quot & ".xls"
objMailItem.Send
Set objMailItem = Nothing
.MoveNext
Wend
End With

set objOlApp = Nothing
Set rstEmails = Nothing
Set conn = Nothing
Set db = Nothing


The green part is for DAO model (Access 97), red part is for ADO (default in Access 2000 and XP). Choose whichever works for you - but not both.

Error handling is up to you...

HTH



Daniel Vlas
Systems Consultant

http://www.geocities.com/danvlas/AutoMail.html

 

[amal1973]

I am so sorry for not being able to thank you for your help . with little customization , i built a very smoth process . thanks

 

[adamroof]

Just had to share this...
It works fine with err handling from null attachments and null CC's in case they want to email without a cc or attach, and im requiring the subj and body.
Make sure you have Outlook and DAO references checked.
It may seem odd to call variables then use the me.name, but it had probs use vars, maybe someone can point out why.
**********
Private Sub sendEmailBtn_Click()
On Error GoTo Err_sendEmail
Dim db As DAO.Database, rst As DAO.Recordset
Dim strBody, subject, email As String
Dim varCC, varAtt As Variant
Dim objOutlook As Object 'Outlook.Application
Dim objEmail As Object 'Outlook.MailItem

email = Me.emailTo
varCC = Me.emailCC
subject = Me.emailSubj
strBody = Me.emailBody
varCC = Me.emailCC
varAtt = Me.Text14

If IsNull(Me.emailSubj) Then
MsgBox "There must be something in the subject line for proper email functionality"
Exit Sub
End If
If IsNull(Me.emailBody) Then
MsgBox "There must be something in the body for proper email functionality"
Exit Sub
End If
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

Set db = CurrentDb
Set rst = db.OpenRecordset("tblHistory&quot
rst.AddNew

rst!HistType = "Email"
rst!HistNotes = Me.emailSubj
rst!HistDetails = strBody
rst!HistDate = Format(Now(), "mm/dd/yyyy&quot
rst!HistTime = Format(Time(), "hh:mm&quot
rst!ContactID = Me.ContactID.Value
rst!HistAttachFile = Me.Text14.Value

rst.Update
rst.Close
db.Close

Set objOutlook = CreateObject("Outlook.application&quot
Set objEmail = objOutlook.CreateItem(olMailItem)

With objEmail
.to = email
.subject = subject
.Body = strBody
If IsNull(varCC) And IsNull(varAtt) Then
.Send
ElseIf IsNull(varAtt) Then
.CC = varCC
.Send
Else
.Attachments.Add varAtt, olByValue, 1
.Send
End If
End With

Set objEmail = Nothing

'objOutlook.Quit

Forms![Contacts].[subHistory].Requery
DoCmd.Close acForm, Me.Name

Err_sendEmail:
Exit Sub
End Sub