NetReport

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 Chang

' es 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

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