使用vba代码发送电子邮件的按钮
使用vba代码发送电子邮件的按钮
提问于 2017-07-15 23:06:58
我已经在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回答 1
Stack Overflow用户
发布于 2017-07-15 23:39:16
循环遍历记录集：
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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/45119643
复制相关文章
相似问题
腾讯云开发者
