2017-04-20 128 views
0

下面的代码创建一封电子邮件。它只适用于数据库的第一个记录。此外,代码将所有字段放在主体中。我希望它只将“请求来自财务”的字段放在该字段中。来自Access 2010的Outlook电子邮件

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 

回答

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

相关问题