遍历文件夹并创建 Outlook 电子邮件

Question

我有一个路径 T:\Fin\Reports\Final 报告

我每个月都会为小组保存不同的报告。文件保存为组名：Acct、Pal、Mg、Qrt 等

我有一个图表，我计划在其中构建我的 VBA，在单元格 G2 中有组代码，在单元格 H2 中有文件需要发送到的电子邮件地址。

例如：

单元格 G2 = 帐户
单元格 H2 = Tim.Doe@Company.com
G3 单元格 = Pal
单元格 H3 = Jane.Doe@Company.com

我有这个用于创建电子邮件的股票代码。我如何实现 for loop 以便循环遍历文件夹中的所有文件并为每个组创建单独的电子邮件并发送到正确的电子邮件地址？

Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)

With xEmailObj
    .Display
    .To = Range("H2")
    .CC = ""
    .Subject = "Monthly Report"
    .Attachments.Add ??????
End With

Answer 1

像这样：

Const FPATH As String = "T:\Fin\Reports\Final Reports\"

Dim rw As Range, xOutlookObj, xEmailObj, attPath 

Set xOutlookObj = CreateObject("Outlook.Application")

Set rw = Thisworkbook.Worksheets("Info").Range("G2:H2")

do while application.counta(rw) = 2 'loop over rows while have content

    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .To = rw.cells(2).value
        .CC = ""
        .Subject = "Monthly Report"
        attPath = FPATH & rw.cells(1).value & ".xlsx"
        Debug.Print rw.cells(2).value, attPath
        .Attachments.Add attPath
        .Display
    End With
   
    Set rw = rw.offset(1, 0)
loop

遍历文件夹并创建 Outlook 电子邮件

Loop through folder and create Outlook emails

outlook

vba