Question

我有一个要求，即通过Excel自动跟进，并且需要通过VBA脚本发送提醒电子邮件。我收到了所有信息，但是通过单击excel工作簿中的命令按钮发送自动电子邮件会引发错误。请帮助我

Sub SendReminderMail()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As String

Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)

With OutLookMailItem
MailDest = ""
For iCounter = 1 To WorksheetFunction.CountA(Columns(13))
If MailDest = "" And Cells(iCounter, 13).Offset(0, -1) = "Send Reminder" Then
MailDest = Cells(iCounter, 13).Value
ElseIf MailDest <> "" And Cells(iCounter, 13).Offset(0, -1) = "Send Reminder" Then
MailDest = MailDest & ";" & Cells(iCounter, 13).Value
End If
Next iCounter

.BCC = MailDest
.Subject = "Due date approaching"
.Body = "Reminder: Your due date is near approaching . Please ignore if already paid."
.Send
End With

Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub

我已经修改了我的脚本

Sub datesexcelvba()
Dim myApp, mymail
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long

Dim x As Long
lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lastrow

mydate1 = Cells(x, 6).Value
mydate2 = mydate1

Cells(x, 9).Value = mydate2

datetoday1 = Date
datetoday2 = datetoday1

Cells(x, 10).Value = datetoday2

If mydate2 - datetoday2 = 3 Then

Set myApp = CreateObject(Outlook.Application)
Set mymail = myApp.CreateItem(olMailItem)
mymail.To = Cells(x, 5).Value

With mymail
.Subject = "Payment Reminder"
.Body = "Your credit card payment is due." & vbCrLf & "Kindly ignore if already paid." & vbCrLf & "Dinesh Takyar"
.Display
‘.Send
End With

Cells(x, 7) = "Yes"
Cells(x, 7).Interior.ColorIndex = 3
Cells(x, 7).Font.ColorIndex = 2
Cells(x, 7).Font.Bold = True
Cells(x, 8).Value = mydate2 - datetoday2
End If
Next
Set myApp = Nothing
Set mymail = Nothing

End Sub

它没有显示错误但是因为我无法发送电子邮件。我也在VB Tools-＆gt; References-＆gt;中检查了Microsoft Outlook 12.0对象库，但它不起作用。请帮忙

Answer 1

用这个替换用于构建MailDest变量的相关代码部分。

MailDest = vbNullString
For iCounter = 1 To WorksheetFunction.CountA(Columns(13))
    If Cells(iCounter, 13).Offset(0, -1) = "Send Reminder" Then
        If Not CBool(InStr(1, .to, Chr(64))) Then
            .to = Cells(iCounter, 13).Value
        ElseIf Not CBool(InStr(1, MailDest, Chr(64))) Then
            MailDest = Cells(iCounter, 13).Value
        Else
            MailDest = MailDest & ";" & Cells(iCounter, 13).Value
        End If
    End If
Next iCounter

第一个收件人将进入邮件项目的.To。后续收件人将进入MailDest var，稍后将其放入.BCC。

Answer 2

代码已被修改并正常运行。单击excel中的Visual Basic代码环境

首先从工具中选择Outlook库 - ＆gt;参考 - ＆GT; Microsoft Outlook 12.0库或您拥有的任何其他版本的Outlook库。

Sub Email()
'Dim OutlookApp As Outlook.Application
Dim OutlookApp
Dim objMail
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long
Dim x As Long
lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lastrow

mydate1 = Cells(x, 6).Value
mydate2 = mydate1

Cells(x, 9).Value = mydate2

datetoday1 = Date
datetoday2 = datetoday1

Cells(x, 10).Value = datetoday2

If mydate2 - datetoday2 = 1 Then

'Set OutlookApp = New Outlook.Application
Set OutlookApp = CreateObject("Outlook.Application")
Set objMail = OutlookApp.CreateItem(olMailItem)
objMail.To = Cells(x, 5).Value
k
With objMail
.Subject = "Payment Reminder"
.Body = "Your payment is due." & vbCrLf & "Kindly ignore if already paid." & vbCrLf & "Hari"
'.Display
.send
End With

Cells(x, 7) = "Yes"
Cells(x, 7).Interior.ColorIndex = 3
Cells(x, 7).Font.ColorIndex = 2
Cells(x, 7).Font.Bold = True
Cells(x, 8).Value = mydate2 - datetoday2
End If
Next
Set OutlookApp = Nothing
Set objMail = Nothing

End Sub

使用VBA在Excel中到期日期后发送提醒跟进

2 个答案: