如何使用VBA附加所有工作表但首先在电子邮件中

VSE 发表于 Dev

一切

我有一本有 4 张纸的工作簿：

1st - 收件人电子邮件数据，例如TO, CC, Subject, 从 2nd 到 4th 我需要作为附件发送给收件人的工作表。

我编写了以下脚本。但是作为 VBA 初学者，我面临两个问题：

“循环”还建议从第一个工作表发送第一个空行（我想在最后一封电子邮件详细信息中停下来）；
“ActiveWorkbook”发送所有工作表（我想跳过收件人和 VBA 脚本所在的第一个工作表）；

我感谢每一个建议/评论，因为我已经学习了 3 个月的 VBA。先感谢您！

Sub ICO_Emails()
    Dim VSEApp As Object
    Dim VSEMail As Object
    Dim VSEText As String
    Dim Email_Send_To, Email_Cc, Email_Subject As String

    row_number = 1

    Do
        DoEvents
        row_number = row_number + 1
        Email_Send_To = Sheet1.Range("A" & row_number)
        Email_Cc = Sheet1.Range("B" & row_number)
        Email_Subject = Sheet1.Range("C" & row_number)
        On Error GoTo debugs
        Set VSEApp = CreateObject("Outlook.Application")
        Set VSEMail = VSEApp.CreateItem(0)
        'Email Body script
        VSEText = "<BODY style=font-size:14pt;font-family:Times New Roman>Dear all,<p>Test.<p></BODY>"
        'Email Signature
        With VSEMail
            .Display
        End With
        Signature = VSEMail.HTMLBody
        With VSEMail
            .To = Email_Send_To
            .CC = Email_Cc
            .Subject = Email_Subject
            .HTMLBody = VSEText & Signature
            .Attachments.Add ActiveWorkbook.FullName
            .Display
        End With
debugs:
    Loop Until Email_Send_To = ""
End Sub

汤姆

看看这个。这会复制您的工作簿并将其保存到用户的“临时”位置。然后在附加之前对工作簿的副本进行您想要的修改。

Sub ICO_Emails()
    Dim VSEApp As Object
    Dim VSEMail As Object
    Dim VSEText As String
    Dim Email_Send_To, Email_Cc, Email_Subject As String
    Dim wb As Workbook, nwb As Workbook

    Application.ScreenUpdating = False

    Set wb = ThisWorkbook
    wb.SaveCopyAs (Environ("temp") & "\temp_" & wb.Name)

    Set nwb = Workbooks.Open(Environ("temp") & "\temp_" & wb.Name)
    With nwb
        Application.DisplayAlerts = False
        ' Delete relevant sheet
        .Sheets(1).Delete
        Application.DisplayAlerts = True
        .Save
    End With

    row_number = 1

    Do
        DoEvents
        row_number = row_number + 1
        Email_Send_To = Sheet1.Range("A" & row_number)
        Email_Cc = Sheet1.Range("B" & row_number)
        Email_Subject = Sheet1.Range("C" & row_number)
        On Error GoTo debugs
        Set VSEApp = CreateObject("Outlook.Application")
        Set VSEMail = VSEApp.CreateItem(0)
        'Email Body script
        VSEText = "<BODY style=font-size:14pt;font-family:Times New Roman>Dear all,<p>Test.<p></BODY>"
        'Email Signature
        With VSEMail
            .Display
        End With
        Signature = VSEMail.HTMLBody
        With VSEMail
            .To = Email_Send_To
            .CC = Email_Cc
            .Subject = Email_Subject
            .HTMLBody = VSEText & Signature
            .Attachments.Add nwb.FullName
            .Display
        End With
debugs:
    Loop Until Email_Send_To = ""
    nwb.Close
    Application.ScreenUpdating = True
End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。