Here is some code I have used:
I choose to use "display" rather than "send" so the email can be inspected
before sending.
This requires the a reference to a Microsoft Outlook Object Library. While
in code click Tools...references and find the latest one in the list.
Private Sub cmdSendEmail_Click()
On Error GoTo MyError
Dim myOL, myNewMessage, strMyPath As String
Set myOL = New Outlook.Application
Set myNewMessage = myOL.CreateItem(olMailItem)
With myNewMessage
.Subject = "Subject Text"
.Body = "Subject Text"
.To = "Target Email Address"
strMyPath = "The path to my file" ' as in "C:\My Documents\MyFile.doc"
.Attachments.Add strMyPath, olByValue
.Display
End With
Exit Sub
MyError:
Application.Echo True
Re = vbNo
Re = MsgBox(Err.Number & " " & Err.Description _
& Chr(13) & "Would you like to continue?", vbYesNo, " Send Email ")
If Re = vbYes Then Resume Next
DoCmd.SetWarnings True
End Sub
--
Never stop learning, never stop helping.
"MS Access Question" wrote:
> I am trying to send an automated email message with an MS Word attachment
> using MS Access and MS Outlook. Everything works fine until I use the
> Attachment.Add command, I get an error message "Cannot write to file..."
> I am not trying to write a file, I am merely trying to attach an existing
> file... any thoughts?
>
> Option Compare Database
> Option Explicit
>
> Private Sub cmdMerge_Click()
> On Error GoTo Err_cmdMerge_Click
>
> Dim db As DAO.Database, rst As DAO.Recordset
> Dim First As String
> Dim Email As String
> Set db = CurrentDb
> Set rst = db.OpenRecordset("qry_JobContactMerge")
> DoEvents
>
> rst.MoveFirst
>
> Do Until rst.EOF
> First = rst![FIRSTNAME]
>
> DoEvents
>
> Call SendEmail(Email, First)
>
> Me.TxtProcess = rst![EMAILName]
>
> rst.MoveNext
> Loop
>
>
>
> Exit_cmdMerge_Click:
> Exit Sub
>
> Err_cmdMerge_Click:
> MsgBox Err.Description
> Resume Exit_cmdMerge_Click
>
> End Sub
>
>
>
> Private Sub cmdQuit_Click()
> On Error GoTo Err_cmdQuit_Click
>
> If Me.Dirty Then Me.Dirty = False
> DoCmd.Quit
>
> Exit_cmdQuit_Click:
> Exit Sub
>
> Err_cmdQuit_Click:
> MsgBox Err.Description
> Resume Exit_cmdQuit_Click
>
> End Sub
>
>
> '******begin code*****
> Function SendEmail(Email As String, First As String)
> Dim strEmail, strBody As String
> Dim objOutlook As Outlook.Application
> Dim objEmail As Outlook.MailItem
>
> '**creates an instance of Outlook
> Set objOutlook = CreateObject("Outlook.application")
> Set objEmail = objOutlook.CreateItem(olMailItem)
>
> '**************************************************************
> '*create string with email address
>
> strEmail = EMAIL
>
> 'strBody = txtTDate & Chr(13) & Chr(13)
> strBody = strBody & "Hello " & First & "," & Chr(13) & Chr(13)
> strBody = strBody & "Thank you for your recent correspondence." & Chr(13)
> strBody = strBody & "Sincerely," & Chr(13) & Chr(13)
>
> '***creates and sends email
> With objEmail
> .To = strEmail
> .SUBJECT = "My Document is attached"
> .body = strBody
> .Attachments.Add ("C:\Users\John\Documents\MSWordDoc2003Format.doc")
> 'add attachment
> .Send
> End With
>
>
> Set objEmail = Nothing
> objOutlook.Quit
>
> Exit Function
>
> End Function
> '****end code*****
>
>
>
|
Similar Threads
