尝试让 vba 嵌套 for 循环以用于电子邮件和 pdf 导出

Question

此代码应该执行以下操作：

将数组中列出的四个工作表（dim as s）导出为 pdf
将该 pdf 附加到电子邮件中并添加一条简单的通用消息
将适用的电子邮件地址插入电子邮件的“收件人”字段
显示电子邮件以允许用户在点击发送之前查看它。

除了第 3 步外，我的代码工作正常。

我遇到的问题是让 4 个电子邮件地址正确循环以将它们加载到电子邮件的“收件人：字段”中。它会将第一个电子邮件地址分配给“strNames”，但会继续使用它，直到所有 4 个工作表都导出后，因此它们都被发送到 ABC@gmail.com 只有在退出该循环后，它才会向下循环到下一个电子邮件地址 Achieve@gmail.com 因为有 4 个电子邮件地址和 4 个工作表，所以我最终得到了 16 封电子邮件，而应该是 4 封不同的电子邮件，每封电子邮件都有 4 个不同的适用附件。

我需要在代码中使用一个嵌套循环来遍历电子邮件列表，但我一直无法让它按预期工作。我在下面添加了一些注释来说明需要什么。

澄清一下，完成后我的桌面上应该有 4 封电子邮件准备发送如下：

发送至“ABC@gmail.com”的电子邮件及附件：2022 02 (TED)_ABC Therapy.pdf 一封发送至“Achieve@gmail.com”的电子邮件，附有文件：2022 02 (TED)_Achievement Therapy.pdf 一封发送至“Barb@gmail.com”的电子邮件，附有文件：2022 02 (TED)_Barb Therapy.pdf 一封发送至“Robin@yahoo.com”的电子邮件及附件：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
    `"ABC@gmail.com"`
    'ActiveWorkbook.Worksheets("Achieve Therapy").Select    Email for Achieve Therapy is
    `"Achieve@gmail.com"`
    'ActiveWorkbook.Worksheets("Barb Therapy").Select       Email for Barb Therapy is
    `"Barb@gmail.com"`
    'ActiveWorkbook.Worksheets("Felisa, Robin V.").Select   Email for Felisa, Robin V. is
    `"Robin@yahoo.com"`    

    Dim sh As Variant
    Dim strNames(1 To 4) As String

    strNames(1) = "ABC@gmail.com"
    strNames(2) = "Achieve@gmail.com"
    strNames(3) = "Barb@gmail.com"
    strNames(4) = "Robin@yahoo.com"

    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

Answer 1

很容易看出您在此代码中获得了 16 个结果（或电子邮件），因为您使用了两个 4 次循环。基本上，您的 For i 循环会重复您的 For each 循环四次。

我会做的是删除你的 For i 循环，并可能在代码后面添加一个验证 (if-then) 来验证发送结果的电子邮件地址到。为了方便和简单起见，我现在只添加一个计数器。

Sub PDF_to_Email_2022_03_07()    

'ActiveWorkbook.Worksheets("ABC Therapy).Select         Email for ABC Therapy is 
`"ABC@gmail.com"`
'ActiveWorkbook.Worksheets("Achieve Therapy").Select    Email for Achieve Therapy is 
`"Achieve@gmail.com"`
'ActiveWorkbook.Worksheets("Barb Therapy").Select       Email for Barb Therapy is 
`"Barb@gmail.com"`
'ActiveWorkbook.Worksheets("Felisa, Robin V.").Select   Email for Felisa, Robin V. is 
`"Robin@yahoo.com"`


Dim sh As Variant
Dim strNames(1 To 4) As String
Dim counter as integer
counter=1

strNames(1) = "ABC@gmail.com"
strNames(2) = "Achieve@gmail.com"
strNames(3) = "Barb@gmail.com"
strNames(4) = "Robin@yahoo.com"




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

Answer 2

我之前运行在删除 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) = "ABC@gmail.com"
    strNames(2) = "Achieve@gmail.com"
    strNames(3) = "Barb@gmail.com"
    strNames(4) = "Robin@yahoo.com"

    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

尝试让 vba 嵌套 for 循环以用于电子邮件和 pdf 导出

Trying to get vba nested for loop to work for email and pdf export

pdf

excel

outlook

vba

loops