此代碼應該執行以下操作：
- 將陣列中列出的四個作業表（dim as s）匯出為 pdf
- 將該 pdf 附加到電子郵件并添加簡單的通用訊息
- 將適用的電子郵件地址插入電子郵件的“收件人”欄位
- 顯示電子郵件以允許用戶在點擊發送之前查看它。
除了第 3 步之外，我的代碼作業正常。
我遇到的問題是讓 4 個電子郵件地址正確回圈以將它們加載到電子郵件的“收件人：欄位”中。它會將第一個電子郵件地址分配給“strNames”，但會繼續使用它，直到所有 4 個作業表都匯出后，所以它們都被發送到 [email protected] 只有在它退出該回圈后，它才會回圈到下一個電子郵件地址 [email protected] 因為有 4 個電子郵件地址和 4 個作業表，所以我最終收到了 16 封電子郵件，而應該是 4 封不同的電子郵件，每封都有 4 個不同的適用附件。
我需要在代碼中使用嵌套回圈來回圈瀏覽電子郵件串列，但我一直無法讓它按需要作業。我在下面添加了一些注釋來說明需要什么。
澄清一下，完成后，我的桌面上應該準備好發送 4 封電子郵件，如下所示：
發給“[email protected]”的電子郵件并附上檔案：2022 02 (TED)_ABC Therapy.pdf 發給“[email protected]”的電子郵件并附上檔案：2022 02 (TED)_Achievement Therapy.pdf 一封電子郵件發給“[email protected]”并附上檔案：2022 02 (TED)_Barb Therapy.pdf 發給“[email protected]”的電子郵件附上檔案：2022 02 (TED)_Felisa, Robin V..pdf
我將不勝感激有關此 VBA 代碼的任何幫助。
謝謝，特德
Sub PDF_to_Email_2022_03_07()
'ActiveWorkbook.Worksheets("ABC Therapy).Select Email for ABC Therapy is
`"[email protected]"`
'ActiveWorkbook.Worksheets("Achieve Therapy").Select Email for Achieve Therapy is
`"[email protected]"`
'ActiveWorkbook.Worksheets("Barb Therapy").Select Email for Barb Therapy is
`"[email protected]"`
'ActiveWorkbook.Worksheets("Felisa, Robin V.").Select Email for Felisa, Robin V. is
`"[email protected]"`
Dim sh As Variant
Dim strNames(1 To 4) As String
strNames(1) = "[email protected]"
strNames(2) = "[email protected]"
strNames(3) = "[email protected]"
strNames(4) = "[email protected]"
Dim i As Long
For i = 1 To 4
For Each sh In Array _
("ABC Therapy", "Achieve Therapy", "Barb Therapy", "Felisa, Robin V.")
Sheets(sh).Select
Dim Wb As Workbook
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Set Wb = Application.ActiveWorkbook
FileName = Wb.FullName
xIndex = VBA.InStrRev(FileName, ".")
If xIndex > 1 Then FileName = VBA.Left(FileName, xIndex - 24)
FileName = FileName & "_" ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = strNames(i)
.CC = ""
.BCC = ""
.Subject = "EI Payment Report"
.Body = "Enclosed is your monthly Report."
.Attachments.Add FileName
.Display
End With
Kill FileName
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Next sh
Next i
End Sub
uj5u.com熱心網友回復：
很容易看出，您在此代碼中收到了 16 個結果（或電子郵件），因為您使用了兩個 4 次周期。基本上你的For i回圈是重復你的For 每個回圈四次。
我要做的是洗掉您的For i回圈，并可能稍后在代碼中添加驗證（if-then）以驗證將結果發送到的電子郵件地址。為了方便和簡單起見，我現在只添加一個計數器。
Sub PDF_to_Email_2022_03_07()
'ActiveWorkbook.Worksheets("ABC Therapy).Select Email for ABC Therapy is
`"[email protected]"`
'ActiveWorkbook.Worksheets("Achieve Therapy").Select Email for Achieve Therapy is
`"[email protected]"`
'ActiveWorkbook.Worksheets("Barb Therapy").Select Email for Barb Therapy is
`"[email protected]"`
'ActiveWorkbook.Worksheets("Felisa, Robin V.").Select Email for Felisa, Robin V. is
`"[email protected]"`
Dim sh As Variant
Dim strNames(1 To 4) As String
Dim counter as integer
counter=1
strNames(1) = "[email protected]"
strNames(2) = "[email protected]"
strNames(3) = "[email protected]"
strNames(4) = "[email protected]"
For Each sh In Array _
("ABC Therapy", "Achieve Therapy", "Barb Therapy", "Felisa, Robin V.")
Sheets(sh).Select
Dim Wb As Workbook
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Set Wb = Application.ActiveWorkbook
FileName = Wb.FullName
xIndex = VBA.InStrRev(FileName, ".")
If xIndex > 1 Then FileName = VBA.Left(FileName, xIndex - 24)
FileName = FileName & "_" ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = strNames(counter)
counter=counter 1
.CC = ""
.BCC = ""
.Subject = "EI Payment Report"
.Body = "Enclosed is your monthly Report."
.Attachments.Add FileName
.Display
End With
Kill FileName
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Next sh
End Sub
uj5u.com熱心網友回復：
我之前在洗掉 PDF 時遇到過檔案鎖定問題。我不會洗掉 PDF，而是將它們保存到目錄中的檔案夾中Environ("Temp")。
Sub PDF_to_Email_2022_03_07()
Const Subject As String = "EI Payment Report"
Const Body As String = "Enclosed is your monthly Report."
Dim SheetNames As Variant
SheetNames = Array("ABC Therapy", "Achieve Therapy", "Barb Therapy", "Felisa, Robin V.")
Dim strNames(1 To 4) As String
strNames(1) = "[email protected]"
strNames(2) = "[email protected]"
strNames(3) = "[email protected]"
strNames(4) = "[email protected]"
Dim i As Long
For i = 0 To 3
GetPDFEmail ws:=Worksheets(SheetNames(i)), ToAddress:=strNames(i), Subject:=Subject, Body:=Body
Next i
End Sub
Function GetPDFEmail(ws As Worksheet, Optional ToAddress As String, Optional CC As String, Optional BCC As String, Optional Subject As String, Optional Body As String, Optional Display As Boolean = True)
Dim FileName As String
FileName = PDFFileName(ActiveWorkbook, ws)
ws.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = ToAddress
.CC = CC
.BCC = BCC
.Subject = "EI Payment Report"
.Body = "Enclosed is your monthly Report."
.Attachments.Add FileName
.Display
End With
Kill FileName
End Function
Function PDFFileName(wb As Workbook, ws As Worksheet) As String
Dim xIndex As Long
xIndex = VBA.InStrRev(wb.FullName, ".")
PDFFileName = VBA.Left(wb.FullName, xIndex - 24) & "_" ws.Name & ".pdf"
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/442059.html