用于使用vba代码发送电子邮件的按钮

Question

我在Access 2010表单上创建了一个按钮。我想向我的表格中的所有客户发送电子邮件，并向电子邮件添加报告。此外，我的报告是基于客户的，因此我必须使用表格创建报告。我无法设法在没有表格的情况下获得基于客户的报告。

我管理了大部分的项目。但是，当我说去表单上的下一个记录，并更改信息我的代码不起作用。 acNext没有做好工作。有没有办法让它工作？

如果你不介意，评论和变量是我的主要语言。

感谢

Public Sub Komut15_Click() 


    Dim oApp As New Outlook.Application 
    Dim oemail As Outlook.MailItem 
    Dim fileName As String, todaydate As String 


    Dim db As DAO.Database 
    Dim rs As DAO.Recordset 

    Set db = CurrentDb 
    Set rs = db.Openrecordset("SELECT Ad, Soyad, Email, Limit, Adres FROM Musteriler Sorgu") 

    Do Until rs.EOF 

    On Error Resume Next 
    DoCmd.GoToRecord , , acNext 



     'Raporu müşteri bazında olması için düzenliyoruz 

     DoCmd.OpenReport "MusteriRaporu", acViewReport, "", "[Forms]![MusteriFormu]![Ad]=[Musteriler]![Ad]", acNormal 


     'Raporu pdf file olarak dışa aktarıyoruz 
     todaydate = Format(Date, "DDMMYYYY") 
     fileName = Application.CurrentProject.Path & "\MusteriRaporu_" & todaydate & ".pdf" 
     DoCmd.OutputTo acReport, "MusteriRaporu", acFormatPDF, fileName, False 



     Set oemail = oApp.CreateItem(olMailItem) 
     oemail.To = rs.Fields("Email") 
     oemail.Subject = Me.Firma_Adı & " Bakiye Raporu" 
     oemail.Body = "Bakiye raporunuz ektedir." 
     oemail.Attachments.Add fileName 


     With oemail 
      If Not oemail.To <> Me.Email Then 
       .Send 
       MsgBox "Email Gonderildi" 

      Else 
       MsgBox "Mail adresi hatalı!" 

      End If 

     End With 
    rs.MoveNext 

    On Error Resume Next 
    DoCmd.GoToRecord , , acNext 

    Loop 


    rs.Close 

    Set rs = Nothing 
    Set db = Nothing 



End Sub 

Answer 1

通过记录循环：

Public Sub Komut15_Click() 
    On Error GoTo ErrProc 

    Dim oApp As Outlook.Application 
    Dim oemail As Outlook.MailItem 
    Dim fileName As String, todaydate As String 

    Dim db As DAO.Database 
    Dim rs As DAO.Recordset 

    Set oApp = New Outlook.Application 
    Set db = CurrentDb 
    Set rs = db.OpenRecordset("SELECT Ad, Soyad, Email, Limit, Adres FROM Musteriler Sorgu") 

    If rs.EOF Then GoTo Leave 
    rs.MoveLast 
    rs.MoveFirst 

    Dim idx As Integer 
    For idx = 1 To rs.RecordCount 

     'Raporu müsteri bazinda olmasi için düzenliyoruz 
     DoCmd.OpenReport "MusteriRaporu", acViewReport, "", "[Forms]![MusteriFormu]![Ad]=[Musteriler]![Ad]", acNormal 

     'Raporu pdf file olarak disa aktariyoruz 
     todaydate = Format(Date, "DDMMYYYY") 
     fileName = Application.CurrentProject.Path & "\MusteriRaporu_" & todaydate & ".pdf" 
     DoCmd.OutputTo acReport, "MusteriRaporu", acFormatPDF, fileName, False 

     Set oemail = oApp.CreateItem(olMailItem) 
     With oemail 
      .To = rs.Fields("Email") 
      .Subject = Me.Firma_Adi & " Bakiye Raporu" 
      .Body = "Bakiye raporunuz ektedir." 
      .Attachments.Add fileName 

      If Not .To <> Me.Email Then 
       .Send 
       MsgBox "Email Gonderildi" 
      Else 
       MsgBox "Mail adresi hatali!" 
      End If 
     End With 

     DoCmd.Close acReport, "MusteriRaporu", acSavePrompt 
     rs.MoveNext 
    Next idx 

Leave: 
    On Error Resume Next 
    rs.Close 
    Set rs = Nothing 
    Set db = Nothing 
    On Error GoTo 0 
    Exit Sub 

ErrProc: 
    MsgBox Err.Description 
    Resume Leave 
End Sub