訪問VBA從DAO記錄集發送outlook.mailitem與循環不循環通過整個表

我希望有人可以幫助我與下面的代碼。嘗試使用特定的電子郵件帳戶（不是默認設置）從Outlook 2010發送電子郵件，該電子郵件基於靜態模板，該模板從表格（發件人_表格）中爲電子郵件正文中的（TO：主題和一些可變字段）提取數據。到目前爲止，下面的代碼的工作原理除了它不循環我的表中的所有記錄。電子郵件通過指定的帳戶發出，並從電子郵件中的表格中提取適當的數據，但在第一條記錄後停止。訪問VBA從DAO記錄集發送outlook.mailitem與循環不循環通過整個表

Private Sub test_Click() 

'You must add a reference to the Microsoft Outlook Library 
Dim OutApp As Outlook.Application 
Dim OutMail As Outlook.MailItem 
Dim strbody As String 
Dim stremail As String 
Dim strsubject As String 

Set OutApp = CreateObject("Outlook.Application") 
Set OutMail = OutApp.CreateItem(olMailItem) 


Dim rs As DAO.Recordset 
Set rs = CurrentDb.OpenRecordset("Senders_Table") 
With rs 

If .EOF And .BOF Then 
MsgBox "No emails will be sent becuase there are no records assigned from the list", vbInformation 
Else 
Do Until .EOF 

    stremail = ![email] 
    strsubject = ![address] 
    strbody = "Dear " & ![name] & "," & _ 
       Chr(10) & Chr(10) & "Some kind of greeting" & ![address] & "!" & _ 
       " email message body goes here" 

    .Edit 
    .Update 
    .MoveNext 

Loop 

End If 
End With 

On Error Resume Next 
With OutMail 
    .To = stremail 
    .CC = "" 
    .BCC = "" 
    .Subject = strsubject 
    .Body = strbody 

    .SendUsingAccount = OutApp.Session.Accounts.Item(2) 
    .Send 
End With 



On Error GoTo 0 

If Not rs Is Nothing Then 
rs.Close 
Set rs = Nothing 
End If 

Set OutMail = Nothing 
Set OutApp = Nothing 

End Sub

來源

2012-10-23 user1769053

您需要在循環中移動您的發送電子郵件代碼，以便爲每條記錄發送一封電子郵件。像這樣：

Set OutApp = CreateObject("Outlook.Application") 

Dim rs As DAO.Recordset 
Set rs = CurrentDb.OpenRecordset("Senders_Table") 
With rs 
    If .EOF And .BOF Then 
     MsgBox "No emails will be sent becuase there are no records assigned from the list", vbInformation 
    Else 
     Do Until .EOF 
      stremail = ![email] 
      strsubject = ![address] 
      strbody = "Dear " & ![name] & "," & _ 
         Chr(10) & Chr(10) & "Some kind of greeting" & ![address] & "!" & _ 
         " email message body goes here" 

      '.Edit 
      '.Update 

      Set OutMail = OutApp.CreateItem(olMailItem) 
      With OutMail 
       .To = stremail 
       .CC = "" 
       .BCC = "" 
       .Subject = strsubject 
       .Body = strbody 

       .SendUsingAccount = OutApp.Session.Accounts.Item(2) 
       .Send 
      End With    
      .MoveNext 
     Loop 

    End If 
End With

來源

2012-10-23 17:39:10 HK1

這對我有用。我有查詢2與字段[電子郵件]; [地址]; [名稱]。

我知道這是一箇舊的線程，但我一直沒能找到任何不會使安全消息彈出的代碼。希望這有助於某人。

Sub SendEmailFromQuery() 
 

 

 
'You must add a reference to the Microsoft Outlook Library 
 
Dim OutApp As Outlook.Application 
 
Dim OutMail As Outlook.MailItem 
 
Dim strbody As String 
 
Dim stremail As String 
 
Dim strsubject As String 
 

 
Set OutApp = CreateObject("Outlook.Application") 
 

 

 
Dim rs As DAO.Recordset 
 
Set rs = CurrentDb.OpenRecordset("Query2") ''add your query here 
 
With rs 
 

 
If .EOF And .BOF Then 
 
MsgBox "No emails will be sent becuase there are no records assigned from the list", vbInformation 
 
Else 
 
Do Until .EOF 
 

 
    stremail = ![email] ''Query2 Fields [email]; [Address]; [Name] 
 
    strsubject = ![Address] 
 
    strbody = "Dear " & ![Name] & "," & _ 
 
       Chr(10) & Chr(10) & "Some kind of greeting" & ![Address] & "!" & _ 
 
       " email message body goes here" 
 

 

 
On Error Resume Next 
 
Set OutMail = OutApp.CreateItem(olMailItem) 
 
With OutMail 
 
    .To = stremail 
 
    .CC = "" 
 
    .BCC = "" 
 
    .Subject = strsubject 
 
    .Body = strbody 
 

 
    .SendUsingAccount = OutApp.Session.Accounts.Item(2) 
 
    .Send 
 
     End With 
 
      .MoveNext 
 
Loop 
 

 
'On Error GoTo 0 
 

 
If Not rs Is Nothing Then 
 
rs.Close 
 
Set rs = Nothing 
 
End If 
 

 
Set OutMail = Nothing 
 
Set OutApp = Nothing 
 

 
End If 
 
End With 
 
End Sub

來源

2015-01-31 22:40:24

訪問VBA從DAO記錄集發送outlook.mailitem與循環不循環通過整個表

回答

相關問題