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

通过Recordset循环：

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

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

1 个答案: