VB icon

E-mail Access Reports

Email
Submitted on: 1/9/2015 12:46:00 AM
By: Miyagi (from psc cd)  
Level: Intermediate
User Rating: By 3 Users
Compatibility: VB 6.0
Views: 2844
 
     Allows you to use Outlook to send bulk e-mails of Access Reports in Snapshot Format to users (ISO Printing, Faxing etc...)
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: E-mail Access Reports
' Description:Allows you to use Outlook to send bulk e-mails of Access Reports in Snapshot Format to users (ISO Printing, Faxing etc...)
' By: Miyagi (from psc cd)
'
' Inputs:Uses an Access Database with User e-mail adresses
Used DAO, thus you need to set a Reference in Outlook to the MS DAO 3.51 Library
'
' Assumes:This code should go in an Oulook module. You can then run the code by itself or by creating a menuitem on your menus.
This would also require you to first save your files as Snapshot files in a specified direcory. You can of course do this in one step but we needed to send 6 files. That would have meant six e-mails, we prefferred to send 1 only and hence the effort to first create the files
'
' Side Effects:No Error Trapping.
'**************************************

'Option Explicit
Public Sub MailToUsers()
Dim myOlApp As Application
Dim myItem As MailItem
Dim Path As String
Dim myAttachments As Attachments
Dim db As Database
Dim rs As Recordset
Dim BodyMsg As String
On Error GoTo myErr
'Set Database and Path to use to use
Set db = OpenDatabase("z:\DatabasePath\dbDatabaseName.mdb")
 
'Set Path to where Files are located
Path = "z:\SnapshotFilesPath\"
'Set Value for Body Message
BodyMsg = "Type whatever bodymessage you might need"
'Set Recordset to Users Table
Set rs = db.OpenRecordset("tblUsers")
'Open or use Outlook
Set myOlApp = CreateObject("Outlook.Application")
rs.MoveLast
rs.MoveFirst
Do Until rs.EOF
'Creates a new Outlook MailItem
Set myItem = myOlApp.CreateItem(olMailItem)
With myItem
.To = rs.Fields("[Email]")
.Subject = "Supply your subject line here"
.Body = BodyMsg
End With
'This Creates an Outlook attachment
Set myAttachments = myItem.Attachments
With myAttachments
'Do for all reports
.Add Path & "\rptReport1.snp"
.Add Path & "\rptReport2.snp"
'************************************
'Additional Documents can be added
'Supply full Path and File Name
'.Add "c:\moc\Questionnaire Script Changes for Dealer Reports 2000_03.doc"
'************************************
'Use myItem.Save ISO myItem.Send to view before sending
'myItem.Save
myItem.Send
End With
'Go to the next user
rs.MoveNext
Loop
Set myOlApp = Nothing
Set rs = Nothing
Set db = Nothing
Exit Sub
myErr:
Resume Next
End Sub


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.