Nat,
The simplest way to send an Email from Access is to use the SendObject
Method of DoCmd Object i.e.
DoCmd.SendObject acSendTable, "Employees", acFormatXLS, _
"Nancy Davolio; Andrew Fuller", "Joan Weber", , _
"Current Spreadsheet of Employees", , True
Look up the onlime help for the SendObject for more info.
Another method would be to use automation to create Outlook Objects, set
properties and call methods i.e.
Public Sub SendEmailMessage(blnShowMsg As Boolean, strSubject As String,
strBody As String, _
Optional strToWhom As String, Optional strCC As String, _
Optional AttachmentPath As String)
Dim olookApp As Object 'Outlook.Application
Dim olookMsg As Object 'Outlook.MailItem
Dim olookRecipient As Object 'Outlook.Recipient
Dim olookAttach As Object 'Outlook.Attachment
Dim blnMultiSelection As Boolean
Dim kounter As Integer, strTemp As String
Dim strFilesSelected(30) As String
Dim strWhomTemp As String
Dim strCCTemp As String
On Error GoTo HandleErr
Const olMailItem = 0
Const olTo = 1
Const olCC = 2
Const olImportanceLow = 0
If InStr(1, AttachmentPath, Chr(9), vbTextCompare) > 0 Then
blnMultiSelection = True
Else
blnMultiSelection = False
End If
' create the Outlook session.
Set olookApp = CreateObject("Outlook.Application")
' create the message.
Set olookMsg = olookApp.CreateItem(olMailItem)
With olookMsg
' add the To recipient(s) to the message.
If Not IsMissing(strToWhom) Then
If Len(strToWhom) > 0 Then
If InStr(strToWhom, "|") > 0 Then
Do
strWhomTemp = Left(strToWhom, InStr(strToWhom, "|") - 1)
Set olookRecipient = .Recipients.Add(strWhomTemp)
olookRecipient.Type = olTo
strToWhom = Mid(strToWhom, InStr(strToWhom, "|") + 1)
If InStr(strToWhom, "|") = 0 Then Exit Do
Loop
Set olookRecipient = .Recipients.Add(strToWhom)
olookRecipient.Type = olTo
Else
Set olookRecipient = .Recipients.Add(strToWhom)
olookRecipient.Type = olTo
End If
End If
End If
' add the CC recipient(s) to the message.
If Not IsMissing(strCC) Then
If Len(strCC) > 0 Then
If InStr(strCC, "|") > 0 Then
Do
strCCTemp = Left(strCC, InStr(strCC, "|") - 1)
Set olookRecipient = .Recipients.Add(strCCTemp)
olookRecipient.Type = olCC
strCC = Mid(strCC, InStr(strCC, "|") + 1)
If InStr(strCC, "|") = 0 Then Exit Do
Loop
Set olookRecipient = .Recipients.Add(strCC)
olookRecipient.Type = olCC
Else
Set olookRecipient = .Recipients.Add(strCC)
olookRecipient.Type = olCC
End If
End If
End If
' set the Subject, Body, and Importance of the message.
.Subject = strSubject
.Body = strBody
.Importance = olImportanceLow 'Low importance
' add attachments to the message.
If Len(AttachmentPath) > 0 Then
If blnMultiSelection Then
strFilesSelected(1) = Left(AttachmentPath, InStr(1,
AttachmentPath, Chr(9), vbTextCompare) - 1)
strTemp = Mid(AttachmentPath, InStr(1, AttachmentPath,
Chr(9), vbTextCompare) + 1)
Set olookAttach = .Attachments.Add(strFilesSelected(1))
For kounter = 2 To 30
If InStr(1, strTemp, Chr(9), vbTextCompare) = 0 Then
strFilesSelected(kounter) = strTemp
Set olookAttach =
..Attachments.Add(strFilesSelected(kounter))
Exit For
Else
strFilesSelected(kounter) = Mid(strTemp, 1, InStr(1,
strTemp, Chr(9), vbTextCompare) - 1)
End If
Set olookAttach =
..Attachments.Add(strFilesSelected(kounter))
strTemp = Mid(strTemp, InStr(1, strTemp, Chr(9),
vbTextCompare) + 1)
Next
Else
Set olookAttach = .Attachments.Add(AttachmentPath)
End If
End If
' resolve each Recipient's name
For Each olookRecipient In .Recipients
olookRecipient.Resolve
If Not olookRecipient.Resolve Then
olookMsg.Display ' display any names that can't be resolved
End If
Next
If blnShowMsg Then
olookMsg.Display
Else
.Send
End If
End With
Set olookMsg = Nothing
Set olookApp = Nothing
ExitHere:
Exit Sub
HandleErr:
Select Case Err.Number
Case 287 'Application-defined or object-defined error
'When user says no to allow access to Outlook
MsgBox "Email cannot be created - permission denied by user????",
vbExclamation, "Warning"
Resume ExitHere
Case Else
MsgBox "Unexpected Error Please inform support " & Err.Number & ": "
& Err.Description, vbCritical, "basSendEmail.SendEmailMessage"
'ErrorHandler:$$N=basSendEmail.SendEmailMessage
Resume ExitHere
End Select
Resume 'Debug Only
End Sub
--
Cheers
Mark
Free Access/Office Add-Ins at:
http://mphillipson.users.btopenworld.com/