Question

我有一张4张工作簿：

第1位 - 收件人通过电子邮件发送数据，例如TO，CC，Subject，从第2位到第4位我需要作为附件发送给收件人的表格。

我编写了以下脚本。但作为VBA初学者我遇到了两个问题：

'loop'建议从第一张纸发送第一个空行同样（我想停止使用最后的电子邮件详情）;
'ActiveWorkbook'发送所有表格（我想跳过第1张收件人和收件人之一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

Answer 1

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

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

Answer 2

保存工作簿的副本
打开它
从副本中删除表格
保存
发送此编辑的工作簿

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

2 个答案: