Attach file to email

  • Thread starter Thread starter Steve
  • Start date Start date
S

Steve

I want to automate the task of attaching an external file
to an email. From within Access, you can attach a table
or report, but how do I automate attaching an external
file, say from the network.

Thanks in advance,

Steve
 
Steve,

Here is some VBA that will work if you are using Outlook Automation to send
your emails. It uses the code found at:

http://www.mvps.org/access/api/api0001.htm to select a file or files.

This code makes use of Windows API calls to allow file selection and
requires no additional OCX file or dialog control (we don't recommend these,
as they are prone to versioning and licensing problems). Don't worry
about the API calls; this code is essentially "plug 'n play".

So, first: create a new Module and name it FileHandling. Then copy all of
the code from that link into the module.

Second: copy the following function into the same module (put it at the
bottom).

Function GetAttachments(strIn As String) As String
'Calls GetOpenFileName dialog and allows user to
'select attachments for an email

Dim strFilter As String

strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
strFilter = ahtAddFilterItem(strFilter, "RTF Documents (*.rtf)", "*.RTF")
strFilter = ahtAddFilterItem(strFilter, "Excel Worksheet Files (*.xls)",
"*.XLS")
strFilter = ahtAddFilterItem(strFilter, _
"Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
"*.mdb; *.mda; *.mde; *.mdw")
strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")

GetAttachments = ahtCommonFileOpenSave(Filter:=strFilter, _
OpenFile:=True, _
DialogTitle:=strIn, _
Flags:=ahtOFN_HIDEREADONLY)
End Function

Last: in the Click event of a command button on your form, insert the
following code

Dim oApp As Outlook.Application
Dim objNewMail As Outlook.MailItem
Dim objOutlookAttach As Outlook.Attachment
Dim strAtt As String

Set oApp = New Outlook.Application
Set objNewMail = oApp.CreateItem(olMailItem)
With objNewMail
.To = "(e-mail address removed)"
.Subject = "Test subject"
.Body = "Your text message here."

' Select files
Do
strAtt = GetAttachments("Select a file - click Cancel when done")
If strAtt <> "" Then
Set objOutlookAttach = .Attachments.Add(strAtt)
Else
Exit Do
End If
Loop
' End selection of files to attach
.Save
.Send

End With
 
Here is some code to learn from

First goto Tools = > References and check the Microsoft Outlook 9.0 Object Library

Function fSendMessage(Optional AttachmentPath, Optional RefNos As String,
Optional EngrName As String,
Optional EngrTitle As String, Optional EngrPhone As String) As Boolea
Dim objOutlook As Outlook.Applicatio
Dim objOutlookMsg As Outlook.MailIte
Dim objOutlookRecip As Outlook.Recipien
Dim objOutlookAttach As Outlook.Attachmen

' Create the Outlook session
Set objOutlook = CreateObject("Outlook.Application"

' Create the message
Set objOutlookMsg = objOutlook.CreateItem(olMailItem

With objOutlookMs
.Displa
' Add the To recipient(s) to the message
Set objOutlookRecip = .Recipients.Add(FAA_ADMIN
Set objOutlookRecip = .Recipients.Add("Yomama"
objOutlookRecip.Type = olT

' Add the CC recipient(s) to the message
'Set objOutlookRecip = .Recipients.Add("Yo papa"
'objOutlookRecip.Type = olC

' Set the Subject, Body, and Importance of the message
.Subject = "Reference No: " & RefNo

If Form_SDS.lblSubmitted.Visible The
.Subject = .Subject & " RE-SUBMIT
End I

.Body = "Hi Portia" & vbCrLf & vbCrLf &
"Please find my latest Site Data Sheet downloaded on the network" & vbCrLf &
"server with the above reference number" & vbCrLf & vbCrLf &
EngrName & vbCrLf & EngrTitle & vbCrLf & EngrPhone & vbCrLf &
"Processing code: " & DB_VERSIO
.Importance = olImportanceHigh 'High importanc

' Add attachments to the message
If Not IsMissing(AttachmentPath) The
Set objOutlookAttach = .Attachments.Add(AttachmentPath
End I

' Resolve each Recipient's name
For Each objOutlookRecip In .Recipient
objOutlookRecip.Resolv
If Not objOutlookRecip.Resolve The
objOutlookMsg.Displa
End I
Nex
'.Sen

End Wit
Set objOutlookMsg = Nothin
Set objOutlook = Nothin
fSendMessage = Tru
End Function
 
Back
Top