Need an Access VBA script to create/mail an email
There is an inbuilt function in Access that can do this, but I cant
remember the name.
If your machine has outlook, you may want to use this routine.
Sub SendOutlookMessage(DisplayMsgBeforeSending As Boolean, _
TheSubject As String, TheBodyMsg As String, _
Optional ToRecipients, Optional CCRecipients, _
Optional BCCRecipients, Optional Attachments)
Const olMailItem = 0
Const olTo = 1
Const olCC = 2
Const olBCC = 3
Dim objOutlook As Object
Dim objOutlookMsg As Object
Dim objOutlookRecip As Object
Dim objOutlookAttach As Object
Dim i As Integer
Dim varCrLf As Variant
' Initialisations
varCrLf = Chr(13) & Chr(10)
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the TO recipient(s) to the message.
If Not IsMissing(ToRecipients) Then
If VarType(ToRecipients) = vbString Then
Set objOutlookRecip = .Recipients.Add(ToRecipients)
objOutlookRecip.Type = olTo
ElseIf VarType(ToRecipients) > vbArray Then
For i = 1 To UBound(ToRecipients)
Set objOutlookRecip =
Recipients.Add(ToRecipients(i))
objOutlookRecip.Type = olTo
Next
End If
End If
' Add the CC recipient(s) to the message.
If Not IsMissing(CCRecipients) Then
If VarType(CCRecipients) = vbString Then
Set objOutlookRecip = .Recipients.Add(CCRecipients)
objOutlookRecip.Type = olCC
ElseIf VarType(CCRecipients) > vbArray Then
For i = 1 To UBound(CCRecipients)
Set objOutlookRecip =
Recipients.Add(CCRecipients(i))
objOutlookRecip.Type = olCC
Next
End If
End If
' Add the BCC recipient(s) to the message.
If Not IsMissing(BCCRecipients) Then
If VarType(BCCRecipients) = vbString Then
Set objOutlookRecip = .Recipients.Add(BCCRecipients)
objOutlookRecip.Type = olBCC
ElseIf VarType(BCCRecipients) > vbArray Then
For i = 1 To UBound(BCCRecipients)
Set objOutlookRecip =
Recipients.Add(BCCRecipients(i))
objOutlookRecip.Type = olBCC
Next
End If
End If
' Set the Subject, Body, and Importance of the message.
.Subject = TheSubject
.Body = TheBodyMsg & varCrLf & varCrLf
' Add attachments to the message.
If Not IsMissing(Attachments) Then
If VarType(Attachments) = vbString Then
Set objOutlookAttach = .Attachments.Add(Attachments)
ElseIf VarType(Attachments) > vbArray Then
For i = 1 To UBound(Attachments)
Set objOutlookRecip =
Attachments.Add(Attachments(i))
Next
End If
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsgBeforeSending Then
.Display
Else
.Send
End If
End With
Set objOutlook = Nothing
End Sub
Works well!!
Good luck
Quote:
>09/23/2000 04:29a EDT
>I need a VBA script (Access97) that will do the following:
> (1) Take email information from an Access97 table and build an outgoing
>email message
> 1a) populate the "To:" email field with an email address (a text
>field in the Access97 table)
> 1b) populate the "Subject:" line with a standard text phrase
>(another text field in the Access97 table)
> 1c) populate the "Body:" of the email with a standard text phrase
>(memo field in the Access97 table)
> (2) Attach a file to the outgoing email message (attached file name is
>in a text field in the Access97 table)
> (3) Save the file and store it in the DRAFT folder (Outlook 98 or
>Outlook Express)
> (email messages will be mailed manually later)
>Can someone tell a VBA newbie where I can download or purchase a script
>(module) that can do this?
>Thanks, in advance (especially you Sue Mosher...you've been VERY helpful)
--------------
Progressive Data Solutions
http://www.pdsolutions.com.au
Home of VB Code Cutter - VB/VBA Code Library & Development Tool
