How to email a document from Access?

  • Thread starter Thread starter Min
  • Start date Start date
M

Min

Hi, I am don't know how to send a document created by Access with email
attach. Anyone can help? Thanks!
 
Thank you for your reply.
Actually, the document is in Excle. I may search how to send Excel by email
using code.
 
' Hope this helps. Just modifly the file type and path sould work from
access.

Option Compare Database
Option Explicit


Dim mGetDPG As String
Dim mGetRecipients As String
Dim mOutlook As Outlook.Application
Dim mOutlookMsg As Outlook.MailItem
Dim mOutlookRecip As Outlook.Recipient
Dim mOutlookAttach As Outlook.Attachment
Dim mstrAddRecipients As String
Dim mAttachmentPath As String
Dim mSession As Outlook.NameSpace
Dim myPathToLookForFile as string
Dim i As Integer
Dim strRemovePath As String
Dim frm As New Form_frmEmailSend


Public Function CreateMail(ByRef astrRecip As Variant, ByRef
astrRecipCC As Variant, strSubject As String, strMessage As String,
Optional astrAttachments As Variant) As Boolean
' This procedure illustrates how to create a new mail message
' and use the information passed as arguments to set message
' properties for the subject, text (Body property), attachments,
' and recipients.
Dim ParaA(5) As String
Dim strSearchCriteria As String
Dim objNewMail As Outlook.MailItem
Dim varRecip As Variant
Dim varAttach As Variant
Dim blnResolveSuccess As Boolean
Dim golApp As Outlook.Application
Dim initializeOutlook As Boolean
Dim fs
Set fs = Application.FileSearch


initializeOutlook = True


On Error GoTo CreateMail_Err


' Use the InitializeOutlook procedure to initialize global
' Application and NameSpace object variables, if necessary.
If golApp Is Nothing Then
If initializeOutlook = False Then
MsgBox "Unable to initialize Outlook Application " _
& "or NameSpace object variables!"
Exit Function
End If
End If


Set golApp = New Outlook.Application
Set objNewMail = golApp.CreateItem(olMailItem)


With objNewMail
' For Each varRecip In astrRecip
.Recipients.Add astrRecip
.CC = astrRecipCC


' Next varRecip
blnResolveSuccess = .Recipients.ResolveAll


With fs
..
fs.LookIn = myPathToLookForFile


' Can include full name or part of the file name for difference
months, times, etc,
'strSearchCriteria = "*".rtf"
strSearchCriteria = "*".xls"


' .FileName = "*.xls"
.filename = strSearchCriteria


If .Execute > 0 Then
'
For i = 1 To .FoundFiles.Count


ParaA(i) = fs.FoundFiles(i)


objNewMail.Attachments.Add ParaA(i),
olByValue, i


Next i


End If


End With


.Subject = strSubject
.Body = strMessage


If blnResolveSuccess = True Then
' .Send
Else
' MsgBox "Unable to resolve all recipients. Please check " _

' & "the names."
.Display
End If
End With


CreateMail = True


CreateMail_End:
Exit Function
CreateMail_Err:
CreateMail = False


' there is some code I seen, were by the prompt warning can be bypass,
click oK automatic.
Select Case Err.Number


Case Is = 287


MsgBox "You clicked No to the Outlook security warning. " & _
"Return the procedure and click Yes to access e-mail" & _
"addresses to send your message. For more information," & _
"see the document at http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp. "


Case Is = -2009989111


MsgBox Err.Number & "" & Err.Description = "Reciepents Error"


Case Is = -1525219325


MsgBox Err.Number & " " & Err.Description = "Attachment Error"


Case Is = 438


MsgBox Err.Number & " " & Err.Description


Case Else


MsgBox Err.Number & "" & Err.Description


End Select


Resume CreateMail_End
End Function


Public Property Get GetDPG() As String


GetDPG = mGetDPG


End Property


Public Property Let GetDPG(ByVal vNewValue As String)


mGetDPG = vNewValue


End Property


Public Property Get GetRecipients() As String


GetRecipients = mGetRecipients


End Property


Public Property Let GetRecipients(ByVal vNewValue As String)


mGetRecipients = vNewValue


End Property


Private Sub Class_Initialize()
'Set mGetDPG = Nothing
'Set mGetRecipients = Nothing
Set mOutlook = Nothing
Set mOutlookMsg = Nothing
Set mOutlookRecip = Nothing
Set mOutlookAttach = Nothing
'Set mstrAddRecipients = Nothing
'Set mAttachmentPath = Nothing
Set mSession = Nothing
End Sub
 
Back
Top