使用Outlook从Access 2010发送电子邮件

时间:2017-04-20 18:53:07

标签: access-vba ms-access-2010

以下代码会创建一封电子邮件。它只适用于db的第一个记录。此外,代码将所有字段放在正文中。我希望它只在现场放置“财务请求”字段。

Private Sub cmdEMail_Click()

    On Error GoTo cmdEMail_Click_Error

    Dim OutApp As Object
    Dim strEMail As String
    Dim OutMail As Object
    Dim strbody As String

    strEMail = Me.EMail
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Please add the following time codes to Oracle for Lilly Project 1005894. Thank you!" & vbCrLf _
            & "" & vbCrLf & "INSTRUCTIONS:" & vbCrLf _
            & "" & vbCrLf & "Make sure the Task Description starts with EU. This is automatically added by entering EU in the Contract field on the form." & vbCrLf _
            & "" & vbCrLf & "If you wish to keep track of your time code requests, CC: yourself on the e-mail and considering entering a compound name or other identifier in the subject line. Alternatively, save a copy of the spreadsheet with your time codes to your desktop." & vbCrLf _
            & "" & vbCrLf & "WRITING TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![WriterTaskNumberName] & vbCrLf _
            & "" & vbCrLf & "ADD DRAFT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![AddDraftTaskNumberName] & vbCrLf _
            & "" & vbCrLf & "EDIT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![EditTaskNumberName] & vbCrLf _
            & "" & vbCrLf & "QUALITY REVIEW TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![DataIntegrityQRTaskNumber] & vbCrLf _
            & "" & vbCrLf & "Task Description =" & [Forms]![frm_Regulatory]![Text186] & vbCrLf

    On Error Resume Next
    If Me.ActiveWritingCode = "Request from Finance" Then

        With OutMail

            .To = strEMail
            .CC = ""
            .BCC = ""
            .Subject = "Lilly EU 1005894 Time Code Request"
            .Body = strbody & vbNewLine & .Body
            .Display

        End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    End If

    On Error GoTo 0
    Exit Sub

cmdEMail_Click_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdEMail_Click of Sub Form_frm_Regulatory"

End Sub

1 个答案:

答案 0 :(得分:0)

这是一个循环遍历表中记录的通用脚本。

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Contacts")

'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst 'Unnecessary in this case, but still a good habit
    Do Until rs.EOF = True
        'Perform an edit
        'rs.Edit
        'rs!VendorYN = True
        'rs("VendorYN") = True 'The other way to refer to a field
        'rs.Update

        'Save contact name into a variable
        'sContactName = rs!FirstName & " " & rs!LastName

        'Move to the next record. Don't ever forget to do this.
        rs.MoveNext
    Loop
Else
    MsgBox "There are no records in the recordset."
End If

MsgBox "Finished looping through records."

rs.Close 'Close the recordset
Set rs = Nothing 'Clean up

这是另一个非常好的例子。

https://msdn.microsoft.com/en-us/library/bb243789(v=office.12).aspx