首页  编辑  

Access发送电子邮件

Tags: /超级猛料/Office.OA自动化/Access/   Date Created:

This will send To, CC and BC as well as Subject, Message, and Attachment

You need 6 text boxes or variables which match the following:

txtMainAddresses

txtCC

txtBCC

txtSubject

txtBody

txtAttachment

Put this in your Module

------------------------------

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

------------------------------

put this in a command button

------------------------------

Private Sub Command0_Click()

On Error GoTo Err_Command0_Click

   Dim stext As String

   Dim sAddedtext As String

   If Len(txtMainAddresses) Then

       stext = txtMainAddresses

   End If

   If Len(txtCC) Then

       sAddedtext = sAddedtext & "&CC=" & txtCC

   End If

   If Len(txtBCC) Then

       sAddedtext = sAddedtext & "&BCC=" & txtBCC

   End If

   If Len(txtSubject) Then

       sAddedtext = sAddedtext & "&Subject=" & txtSubject

   End If

   If Len(txtBody) Then

       sAddedtext = sAddedtext & "&Body=" & txtBody

   End If

   If Len(txtAttachment) Then

       sAddedtext = sAddedtext & "Attach=" & Chr$(34) & Me!txtAttachment & Chr$(34)

   End If

   

   stext = "mailto:" & stext

   

   If Len(sAddedtext) <> 0 Then

       Mid$(sAddedtext, 1, 1) = "?"

   End If

   

   stext = stext & sAddedtext

   

   ' launch default e-mail program

   If Len(stext) Then

       Call ShellExecute(Me.hwnd, "open", stext, vbNullString, vbNullString, SW_SHOWNORMAL)

   End If

Exit_Command0_Click:

   Exit Sub

Err_Command0_Click:

   MsgBox Err.Description

   Resume Exit_Command0_Click

   

End Sub

****************************

Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)

         Dim objOutlook As Outlook.Application

         Dim objOutlookMsg As Outlook.MailItem

         Dim objOutlookRecip As Outlook.Recipient

         Dim objOutlookAttach As Outlook.Attachment

         ' 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.

             Set objOutlookRecip = .Recipients.Add("Nancy Davolio")

             objOutlookRecip.Type = olTo

             ' Add the CC recipient(s) to the message.

             Set objOutlookRecip = .Recipients.Add("Michael Suyama")

             objOutlookRecip.Type = olCC

            ' Add the BCC recipient(s) to the message.

             Set objOutlookRecip = .Recipients.Add("Andrew Fuller")

             objOutlookRecip.Type = olBCC

            ' Set the Subject, Body, and Importance of the message.

            .Subject = "This is an Automation test with Microsoft Outlook"

            .Body = "This is the body of the message." &vbCrLf & vbCrLf

            .Importance = olImportanceHigh  'High importance

            ' Add attachments to the message.

            If Not IsMissing(AttachmentPath) Then

                Set objOutlookAttach = .Attachments.Add(AttachmentPath)

            End If

            ' Resolve each Recipient's name.

            For Each ObjOutlookRecip In .Recipients

                objOutlookRecip.Resolve

            Next

            ' Should we display the message before sending?

            If DisplayMsg Then

                .Display

            Else

                .Save

                .Send

            End If

         End With

         Set objOutlook = Nothing

     End Sub