Excel 将多张图纸保存到不同的工作簿，并使用VBA将其附加到outlook

我需要一个宏来执行以下工作：

我有一本6页的工作簿。每个都有不同的名字。图纸名称为ENT、GHD、T3等

我想复制每张工作表的内容，并将其保存到具有不同名称以及日期和时间戳的不同工作簿中

例如，图纸ENT必须另存为XYZ报告日期时间。Xlsx和此文件需要附加到outlook

同样，对于GHD，文件名应为ABC报告日期时间。Xlsx。 T3表和其他3张表也是如此。所有这些文件都要邮寄给不同的人

---

这些新文件的捕获必须保存到创建它的原始文件的文件夹中。

因此，您希望循环浏览工作表，如下所示：

for Each xSheet In activeworkbook.worksheets

然后使用工作表名称和工作簿路径调用saveas方法

xsheet.saveas activeworkbook.path & xSheet.Name & " Report " & vba.forma(now, "dd mmm yyyy hhmmss"), xlnormal

然后，您需要创建一个Outlook邮件项目，设置收件人、主题和附件，然后发送它

所以这应该可以让您开始，然后您只需在引用中添加对Outlook应用程序的引用，以使您能够使用这些对象

嗯

菲利普 将onePublishObject设置为PublishObject 将一张工作表设置为工作表 将脚本对象作为对象 作为对象的Dim Outlook应用程序 作为对象的Dim outlookMail Dim htmlBody作为字符串 Dim htmlFile作为字符串 Dim textStream，fil As字符串 将虚拟对象设置为工作簿 今天=格式（现在（），“dd-mm-yyyy”） Set dummy=ActiveWorkbook 设置scriptingObject=CreateObject（“Scripting.FileSystemObject”） Set-outlookApplication=CreateObject（“Outlook.Application”） 对于ActiveWorkbook.工作表中的每个工作表 像弦一样暗的链子 StrBody=“这是一个测试”&“&UCase（oneSheet.Name）&”&“XYZ”&vbNewLine&_ vbNewLine&_ “请查找随附的‘XYZ报告’” Application.DisplayAlerts=False 工作表（单张。名称）。复制 ActiveWorkbook.SaveAs dummy.Path&“\”和oneSheet.Name&“.xlsx” 活动工作簿。关闭 Application.DisplayAlerts=True Set-outlookMail=outlookApplication.CreateItem（0） 与了望邮件 .htmlBody=StrBody和htmlBody .attachments.Add dummy.Path&“\”&oneSheet.Name&“.xlsx” 陈列 .Subject=“XYZ报告”&“&UCase（oneSheet.Name）&”&“&”（&Today&”） 以 下一页 端接头

---

我们需要显示您迄今为止尝试的代码以提供帮助。您迄今为止尝试了什么？首先，如果你自己表现出一点努力，你会得到更好的回应。将工作表复制到新工作簿相当简单。通过电子邮件将一张工作表作为附件是绝对受支持的，也不是很困难。保存到一个已知/指定的目录是初学者的东西。在上面的代码1中，我不太明白如何为我的每张工作表指定单独的名称。2.为每一张不同的纸写一封不同的邮件，并发送给不同的人。3.我只想附上7张我的模板中的5张（这意味着5封不同的邮件），我并没有收到任何错误。只是在上面的代码1中，我不太明白如何给我的每张工作表分别命名。2.为每一张不同的纸写一封不同的邮件，并发送给不同的人。3.我只想附上我的7个模板中的5张（这意味着5封不同的邮件），Philip和@Sam需要你们的帮助，我需要什么帮助，为什么？

Sub COMEON()
  Dim onePublishObject As PublishObject
  Dim oneSheet As Worksheet
  Dim scriptingObject As Object
  Dim outlookApplication As Object
  Dim outlookMail As Object
  Dim htmlBody As String
  Dim htmlFile As String
  Dim textStream, fil As String
  Dim dummy As Workbook


  Today = Format(Now(), "dd-mm-yyyy")

  Set dummy = ActiveWorkbook
  Set scriptingObject = CreateObject("Scripting.FileSystemObject")
  Set outlookApplication = CreateObject("Outlook.Application")
  For Each oneSheet In ActiveWorkbook.Worksheets




                                                        Dim StrBody As String
                                                        StrBody = " THIS IS A TEST" & " " & UCase(oneSheet.Name) & " " & "XYZ," & vbNewLine & _
                                                        vbNewLine & _
                                                        "Please FIND ATTACHED <B>'XYZ REPORT'<B>"





    Application.DisplayAlerts = False
    Sheets(oneSheet.Name).Copy
    ActiveWorkbook.SaveAs dummy.Path & "\" & oneSheet.Name & ".xlsx"
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    Set outlookMail = outlookApplication.CreateItem(0)
    With outlookMail
        .htmlBody = StrBody & htmlBody
        .attachments.Add dummy.Path & "\" & oneSheet.Name & ".xlsx"
        .Display
        .Subject = "XYZ Report" & " " & UCase(oneSheet.Name) & " " & "(" & Today & ")"

    End With
  Next oneSheet
End Sub