有没有办法将.pdf文件作为附件附加，同时使用 ms access 将.html文件作为图像插入电子邮件正文中

Question

我在MS Access中编写了一些VBA代码，我正在尝试执行以下操作：

行动： 将 pdf 文件作为附件附加到 MS Outlook 电子邮件 将另存为不同文件路径上的.html文件的 html 文件插入到同一 MS Outlook 电子邮件的 HTML 中;和 循环访问记录集

情况： 目前，我已经编写了将第一个pdf作为附件附加的代码，并将第一个html文件作为图像插入HTML正文中。但是，当代码循环回第 2 个、第 3 个等时，它： 将第二个pdf作为附件附加(应如此(，并将第一个html和第二个html图像插入正文中;再次
循环并附加第 3 个 pdf 作为附件(它应该(，并将第一个 html、第二个 html 和第三个 html 图像插入正文;依此类推

期望的结果： 我希望代码遍历并附加： 第一个 pdf 文件作为附件，第一个 HTML 文件作为 HTMLbody 中的图像 第二个 pdf 文件作为附件，第二个 HTML 文件作为 HTMLbody 中的图像;和 继续完成数据集的末尾，其中电子邮件包含 1 个 pdf 文件作为附件;和 Outlook 电子邮件的 HTML 正文中的 1 个 html 图像。

Private Sub cmdEmailLetters_Click()

Dim folderName As String
Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim FSOFile As Object
Dim FilePathName As String
Dim FilePathName2 As String
Dim rs As DAO.Recordset
Dim db As DAO.Recordset
Dim rsEmail As Recordset
Dim rsEmail2 As Recordset
Dim rsFileName As Recordset
Dim rsGID As Recordset
Dim rsFNHtml As Object
Dim rsFName As Object
Dim strline, strHTML
Dim count As Integer

'Set the file name to a variable
folderName = "H:Customer OutreachCustomer_Letters"

'Set all the references to the FSO Library
Set FSOLibrary = New FileSystemObject
Set FSOFolder = FSOLibrary.GetFolder(folderName)
Set FSOFile = FSOFolder.Files
Set rs = CurrentDb.OpenRecordset("TestFinalEmailList") 
Set rsEmail = CurrentDb.OpenRecordset("TestFinalEmailList") 
Set rsEmail2 = CurrentDb.OpenRecordset("TestFinalEmailList") 
Set rsFileName = CurrentDb.OpenRecordset("TestFinalEmailList") 
Set rsGID = CurrentDb.OpenRecordset("TestFinalEmailList") 
Set rsFNHtml = CurrentDb.OpenRecordset("TestFinalEmailList")
Set rsFName = CurrentDb.OpenRecordset("TestFinalEmailList")

'Use For Each loop to loop through each file in the folder
For Each FSOFile In FSOFolder.Files
Open "H:Customer OutreachCustomer_Letters_htmlCustomer Request - " & rsFNHtml!FILE_NAME_Html 
& ".html" For Input As 1
If Not (rs.EOF And rs.BOF) Then
Do While Not EOF(1)
Input #1, strline
strHTML = strHTML & strline
Loop
Close #1
rsFNHtml.MoveNext
End If
If rsGID!CustID = rsFileName!FILE_NAME Then
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutlook = appOutlook.CreateItem(olMailItem)
With MailOutlook
.BodyFormat = olFormatHTML
.To = rsEmail!CUST_Mn_EMAIL
.CC = rsEmail2!SCND_EMAIL
''.bcc = ""
.Subject = "TEST"
.Importance = olImportanceHigh  'High importance
.HTMLBody = strHTML
.Attachments.Add (FSOFile)
'.Send
.Display    'Used during testing without sending (Comment out .Send if using this line)
End With
Else
MsgBox rsGID!GRANTEEID & " No file matching " & strPath & strFilter & " found." & vbCrLf & _
"Processing terminated."
Exit Sub
End If
rsGID.MoveNext
rsFileName.MoveNext
rsEmail.MoveNext
rsEmail2.MoveNext
Next
'Release the memory
Set FSOLibrary = Nothing
Set FSOFolder = Nothing
Set FSOFile = Nothing
Set rsEmail = Nothing
Set rsFNHtml = Nothing
Set strHTML = Nothing
Set rs = Nothing

MsgBox "Email transfer is complete!", , "STATUS"
End Sub

Answer 1

在For Each FSOFile循环的刚开始，您将HTML部分(包括图像(加载到变量strHTML中，然后将其分配给.HTMLBody。但是，您永远不会清除此变量以准备下一封电子邮件。在"执行"循环之前添加strHTML = ""：

If Not (rs.EOF And rs.BOF) Then
strHTML = ""                'add this line
Do While Not EOF(1)
Input #1, strline
strHTML = strHTML & strline
Loop
Close #1
rsFNHtml.MoveNext
End If

另请注意，(rs.EOF And rs.BOF)应(rs.EOF Or rs.BOF)