我使用以下代码通过IBM Notes使用VBA发送电子邮件。
代码：
Sub SendEmail()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.CutCopyMode = False
'Define Variables
Dim Ref As String
Dim TrueRef As String
Dim Attachment As String
Dim WB3 As Workbook
Dim WB4 As Workbook
Dim Rng As Range
Dim db As Object
Dim doc As Object
Dim body As Object
Dim header As Object
Dim stream As Object
Dim session As Object
Dim i As Long
Dim j As Long
Dim j2 As Long
Dim server, mailfile, user, usersig As String
Dim LastRow As Long, LastRow2 As Long, ws As Worksheet
LastRow = Worksheets(1).Range("F" & Rows.Count).End(xlUp).Row 'Finds the last used row
'Define Depot
Ref = Range("F" & (ActiveCell.Row)).Value
If Ref = "WED" Then
TrueRef = "WED"
Else
If Ref = "WSM" Then
TrueRef = "WES"
Else
If Ref = "NAY" Then
TrueRef = "NAY"
Else
If Ref = "ENF" Then
TrueRef = "ENF"
Else
If Ref = "LUT" Then
TrueRef = "MAG"
Else
If Ref = "NFL" Then
TrueRef = "NOR"
Else
If Ref = "RUN" Then
TrueRef = "RUN"
Else
If Ref = "SOU" Then
TrueRef = "SOU"
Else
If Ref = "SOU" Then
TrueRef = "SOU"
Else
If Ref = "BRI" Then
TrueRef = "BRI"
Else
If Ref = "LIV" Then
TrueRef = "LIV"
Else
If Ref = "BEL" Then
TrueRef = "BEL"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If Ref <> "" Or TrueRef <> "" Then ' FailSafe
'Start a session of Lotus Notes
Set session = CreateObject("Notes.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
Set db = session.CurrentDatabase
Set stream = session.CreateStream
' Turn off auto conversion to rtf
session.ConvertMime = False
'Email Code
'Create email to be sent
Set doc = db.CreateDocument
doc.Form = "Memo"
Set body = doc.CreateMIMEEntity
Set header = body.CreateHeader("Subject")
Call header.SetHeaderVal("Food Specials Delivery Tracker: The Status of Your Issue Has Changed (" & Range("N" & ActiveCell.Row).Value & ")")
'Set From
Call doc.ReplaceItemValue("Principal", "Food Specials <mailto:Food.Specials@Lidl.co.uk>")
Call doc.ReplaceItemValue("ReplyTo", "Food.Specials@Lidl.co.uk")
Call doc.ReplaceItemValue("DisplaySent", "Food.Specials@Lidl.co.uk")
'Set From
Call doc.ReplaceItemValue("Principal", "Food Specials <mailto:Food.Specials@Lidl.co.uk>")
Call doc.ReplaceItemValue("ReplyTo", "Food.Specials@Lidl.co.uk")
Call doc.ReplaceItemValue("DisplaySent", "Food.Specials@Lidl.co.uk")
'To
Set header = body.CreateHeader("To")
Call header.SetHeaderVal("supplychain-" & TrueRef & "@lidl.co.uk")
'Email Body
Call stream.WriteText("<HTML>")
Call stream.WriteText("<font size=""3"" color=""black"" face=""Arial"">")
If Hour(Now) > 12 Then
Call stream.WriteText("<p>Good afternoon,</p>")
Else
Call stream.WriteText("<p>Good morning,</p>")
End If
Call stream.WriteText("<p>Reference: " & Format(CDate(Range("A" & ActiveCell.Row).Value), "DDMMYY") & " - " & Range("C" & ActiveCell.Row).Value & " - " & Range("D" & ActiveCell.Row).Value & "</p>")
If ThisWorkbook.Sheets(1).Range("N" & ActiveCell.Row).Value = "Issue Complete" Then
Call stream.WriteText("<p>Your recent issue has been marked as complete.</p>")
Else
Call stream.WriteText("<p>The status of your recent issue has changed.</p>")
End If
'Insert Range
ThisWorkbook.Sheets(1).Range("A" & ActiveCell.Row & ":K" & ActiveCell.Row & ", N" & ActiveCell.Row).SpecialCells(xlCellTypeVisible).Select
Set Rng = Selection
Call stream.WriteText(RangetoHTML(Rng))
Cells(1, 1).Select
Call stream.WriteText("<BR><BR><p><a href=""G:\WH DISPO\(3) PROMOTIONS\(18) Food Specials Delivery Tracking\Food Specials Delivery Tracker.xlsm"">Click here to view your issue on the Delivery Tracker now.</a></p></br>")
'Signature
Call stream.WriteText("<BR><p>Kind regards / Mit freundlichen Grüßen,</p></br>")
Call stream.WriteText("<p><b>Lidl UK Food Specials Team</b></p>")
Call stream.WriteText("<table border=""0"">")
Call stream.WriteText("<tr>")
Call stream.WriteText("<td><img src=""http://www.lidl.co.uk/statics/lidl-uk/ds_img/layout/top_logo2016.jpg"" alt=""Mountain View""></td>")
Call stream.WriteText("<td><img src=""http://www.lidl.co.uk/statics/lidl-uk/ds_img/assets_x_x/BOQLOP_NEW%281%29.jpg"" alt=""Mountain View""></td>")
Call stream.WriteText("</tr>")
Call stream.WriteText("</table>")
Call stream.WriteText("</font>")
Call stream.WriteText("</body>")
Call stream.WriteText("</html>")
Call body.SetContentFromText(stream, "text/HTML;charset=UTF-8", ENC_IDENTITY_7BIT)
doc.Save True, False
Call doc.PutInFolder("Delivery Tracker Email Notifications")
Call doc.Send(False)
session.ConvertMime = True ' Restore conversion - very important
'Clean Up the Object variables - Recover memory
Set db = Nothing
Set session = Nothing
Set stream = Nothing
Set doc = Nothing
Set body = Nothing
Set header = Nothing
'WB3.Close savechanges:=False
Application.CutCopyMode = False
'Email Code
Else ' Otherwise - FailSafe
'Start a session of Lotus Notes
Set session = CreateObject("Notes.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
Set db = session.CurrentDatabase
Set stream = session.CreateStream
' Turn off auto conversion to rtf
session.ConvertMime = False
'Email Code
'Create email to be sent
Set doc = db.CreateDocument
doc.Form = "Memo"
Set body = doc.CreateMIMEEntity
Set header = body.CreateHeader("Subject")
Call header.SetHeaderVal("Food Specials Delivery Tracker: The Status of Your Issue Has Changed (" & Range("N" & ActiveCell.Row).Value & ")")
'Set From
Call doc.ReplaceItemValue("Principal", "Food Specials <mailto:Food.Specials@Lidl.co.uk>")
Call doc.ReplaceItemValue("ReplyTo", "Food.Specials@Lidl.co.uk")
Call doc.ReplaceItemValue("DisplaySent", "Food.Specials@Lidl.co.uk")
'Set From
Call doc.ReplaceItemValue("Principal", "Food Specials <mailto:Food.Specials@Lidl.co.uk>")
Call doc.ReplaceItemValue("ReplyTo", "Food.Specials@Lidl.co.uk")
Call doc.ReplaceItemValue("DisplaySent", "Food.Specials@Lidl.co.uk")
'To
Set header = body.CreateHeader("To")
Call header.SetHeaderVal("food.specials@lidl.co.uk")
'Email Body
Call stream.WriteText("<HTML>")
Call stream.WriteText("<font size=""3"" color=""black"" face=""Arial"">")
If Hour(Now) > 12 Then
Call stream.WriteText("<p>Good afternoon,</p>")
Else
Call stream.WriteText("<p>Good morning,</p>")
End If
Call stream.WriteText("<p><b>Error: The below email was not delivered to the RDC.</b></p><br>")
Call stream.WriteText("<p>Reference: " & Format(CDate(Range("A" & ActiveCell.Row).Value), "DDMMYY") & " - " & Range("C" & ActiveCell.Row).Value & " - " & Range("D" & ActiveCell.Row).Value & "</p>")
If ThisWorkbook.Sheets(1).Range("N" & ActiveCell.Row).Value = "Issue Complete" Then
Call stream.WriteText("<p>Your recent issue has been marked as complete.</p>")
Else
Call stream.WriteText("<p>The status of your recent issue has changed.</p>")
End If
'Insert Range
ThisWorkbook.Sheets(1).Range("A" & ActiveCell.Row & ":K" & ActiveCell.Row & ", N" & ActiveCell.Row).SpecialCells(xlCellTypeVisible).Select
Set Rng = Selection
Call stream.WriteText(RangetoHTML(Rng))
Cells(1, 1).Select
Call stream.WriteText("<BR><BR><p><a href=""G:\WH DISPO\(3) PROMOTIONS\(18) Food Specials Delivery Tracking\Food Specials Delivery Tracker.xlsm"">Click here to view your issue on the Delivery Tracker now.</a></p></br>")
'Signature
Call stream.WriteText("<BR><p>Kind regards / Mit freundlichen Grüßen,</p></br>")
Call stream.WriteText("<p><b>Lidl UK Food Specials Team</b></p>")
Call stream.WriteText("<table border=""0"">")
Call stream.WriteText("<tr>")
Call stream.WriteText("<td><img src=""http://www.lidl.co.uk/statics/lidl-uk/ds_img/layout/top_logo2016.jpg"" alt=""Mountain View""></td>")
Call stream.WriteText("<td><img src=""http://www.lidl.co.uk/statics/lidl-uk/ds_img/assets_x_x/BOQLOP_NEW%281%29.jpg"" alt=""Mountain View""></td>")
Call stream.WriteText("</tr>")
Call stream.WriteText("</table>")
Call stream.WriteText("</font>")
Call stream.WriteText("</body>")
Call stream.WriteText("</html>")
Call body.SetContentFromText(stream, "text/HTML;charset=UTF-8", ENC_IDENTITY_7BIT)
doc.Save True, False
Call doc.PutInFolder("Delivery Tracker Email Notifications")
Call doc.Send(False)
session.ConvertMime = True ' Restore conversion - very important
'Clean Up the Object variables - Recover memory
Set db = Nothing
Set session = Nothing
Set stream = Nothing
Set doc = Nothing
Set body = Nothing
Set header = Nothing
'WB3.Close savechanges:=False
Application.CutCopyMode = False
'Email Code
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
正在发送代码和电子邮件。我还选择将已发送电子邮件的副本保存在名为Delivery Tracker Email Notifications的文件夹中。
但是，这些电子邮件似乎也出现在草稿文件夹中 - 即使它们已被发送。
请有人解释/告诉我这里哪里出错了？
答案 0 :(得分：0)
保存的副本仍然是草稿，因为尚未发送。您需要在发送后保存它。
即，改变这个：
doc.Save True, False
Call doc.PutInFolder("Delivery Tracker Email Notifications")
Call doc.Send(False)
对此：
Call doc.Send(False)
doc.Save True, False
Call doc.PutInFolder("Delivery Tracker Email Notifications")