导出 Excel 工作表并将其作为电子邮件发送（循环）答案

【问题标题】：Export Excel sheets and send them as emails (Loop)导出 Excel 工作表并将其作为电子邮件发送（循环）
【发布时间】：2017-09-07 04:49:23
【问题描述】：

我正在尝试自动化报告生成和分发过程。我需要做的是创建一个遍历列表（1 到 20）的宏，并为每一行创建一个新文件（单独的 Excel 文件），从当前文件中粘贴 2 个选项卡（工作表名称在 J 和 K 列中）并将其保存在 E 列中的文件名下。然后宏应打开 Outlook 并通过附加文件并使用表中所示的主题、分发列表、电子邮件正文来创建电子邮件。

我非常感谢任何帮助，因为我已经为此烦恼了一段时间。

我知道以前有人问过类似的问题。我试图结合处理这个过程的不同部分的代码。到目前为止，我有以下内容：

enter code here
Sub Create_Files()

Dim MyDateStr As String
Dim wkbCurrent As Workbook
Dim wkbtemp As Workbook
Dim wkbtemp2 As Workbook
Dim MyLocation As String
Dim SheetName As String

Set wkbCurrent = ActiveWorkbook
MyDateStr = wkbCurrent.Sheets("Control").Range("F12")

ChDir "W:\Finance Analysis\Contsys2\DATA\aacorpfinance\_yr 2017\Expense    reports\"
  If Len(Dir(MyDateStr, vbDirectory)) = 0 Then
    MkDir (MyDateStr)
End If

MyLocation = "W:\Finance Analysis\Contsys2\DATA\aacorpfinance\_yr 2017\Expense reports\"

 SheetName = wkbCurrent.Sheets("Emails").Range("C2")

 Set wkbtemp = Workbooks.Add

 wkbCurrent.Sheets(SheetName).Cells.Select


 With wkbtemp
 wkbtemp.Sheets("Sheet1").Range("A1").PasteSpecial



 wkbCurrent.Sheets("M & A").Copy
 wkbtemp2.Sheets("Sheet2").Range("A1").Select
 ActiveSheet.PasteSpecial Paste:=xlValues

 Set wkbtemp = Sheets.Add(After:=Sheets(Sheets.Count))

 End Sub

我还没有到达循环和电子邮件部分，但我有一些我在其他地方找到的代码，我试图以此作为基础。

【问题讨论】：

向我们展示您已经尝试过的内容。并尝试一步一步地去做。之前已经问过数十个类似的问题，因此有大量代码可以帮助您入门。

标签： excel vba email

【解决方案1】：

这里有一些代码可以帮助您入门

它遍历所有行上的所有单元格

只需添加例程来创建电子邮件、添加附件、保存文件等。

Option Explicit

Sub exportIntoEmails()

    Dim rng As Range

    For Each rng In Range("a1:a20")

        Debug.Print "file", rng.Columns("b").Value
        Debug.Print "folder", rng.Columns("d").Value
        Debug.Print "filename", rng.Columns("e").Value
        Debug.Print "subject", rng.Columns("f").Value
        Debug.Print "dist. list", rng.Columns("g").Hyperlinks(1).Address
        Debug.Print "cc list", Replace(rng.Columns("h").Hyperlinks(1).Address, "mailto:", "")
        Debug.Print "email body", rng.Columns("i").Value

        Dim aaa As Range
        For Each aaa In rng.Columns("j").Resize(1, 2)
            Debug.Print "attach", aaa.Value
        Next aaa

    Next rng
End Sub

【讨论】：