email an attached file using MS Access

[dbinGburg]

A customer needs to email various attachments that have not been created in MS Access. He wants to use his Access system which includes his entire customer base with email addresses to do the mailing.



So far I've done the following legwork: created a form with a built in MS Explorer function so he can easily select the file he wishes to send, along with a place for him to key some text and the ability to easily select the customer/customers to receive the email.

That's about as far as I've gotten. I tried putting a command button on my form to use the DoCmd.SendObject statement, but that is obviously a mistake. No where that I can tell to put the object path for the attachment.

I've rarely used email in an Access system, so it's quite possible I'm just ignorant.

Any ideas?

[ranman256]

the code below goes into a form for user to choose the file to email.
the Pickfile() allows user to choose the file
the Email1 sends it, but NOTE: YOU MUST ADD THE OUTLOOK APP IN REFERENCES!!


vTo = "bob@acme.com"
vSubj = "your file"
vBody = "here is the data from the thing"

vFile = UserPick1File("c:\folder")
if vFile <> "" then Call Email1(vTo, vSubj, vBody, vFile)



paste the code below into a public module for all to use

Public Function UserPick1File(pvPath)
Dim strTable As String
Dim strFilePath As String
Dim sDialog As String, sDecr  As String, sExt As String

If IsMissing(pvPath) Then pvPath = "c:\"

With Application.FileDialog(msoFileDialogFilePicker)   'MUST ADD REFERENCE : Microsoft Office 11.0 Object Library
    .AllowMultiSelect = False
    .Title = "Locate a file to Import"
    .ButtonName = "Attach"
    .Filters.Clear
    .Filters.Add sDecr, sExt
    .InitialFileName = pvPath
    .InitialView = msoFileDialogViewList    'msoFileDialogViewThumbnail

        If .show = 0 Then
           'There is a problem
           Exit Function
        End If

    'Save the first file selected
    UserPick1File = Trim(.SelectedItems(1))
End With
End Function



'-------
'YOU MUST ADD THE OUTLOOK APP IN REFERENCES!!!   checkmark OUTLOOK OBJECT LIBRARY in the vbE menu, Tools, References
'-------

Public Function Email1(ByVal pvTo, ByVal pvSubj, ByVal pvBody,optional ByVal pvFile) As Boolean
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem

On Error GoTo ErrMail

Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(olMailItem)

With oMail
    .To = pvTo
    .Subject = pvSubj
    .Body = pvBody

    If Not Ismissing(pvFile) Then  .Attachments.Add pvFile, olByValue, 1
    
.Send
End With

Email1 = True
Set oMail = Nothing
Set oApp = Nothing
Exit Function

ErrMail:
MsgBox Err.Description, vbCritical, Err
Resume Next
End Function

[dbinGburg]

Thanks so much! I'll attempt to incorporate this into my program and see what happens.