VBA电子邮件循环，用于Excel报告 [英] VBA Email Loop for excel reporting

问题描述

我创建了一个宏，该宏将为选定的个人运行报告，并向该人发送包含该软件包的电子邮件.该报告大约可容纳20人，但是为每个人运行该报告然后将其发送很繁琐.

I created a macro that would run a report for a selected indivdual and send that person an email with that package. This report is meant for roughly 20 people, but it has been tedious to run the report for each person and then send it.

我想知道是否有一种方法可以在要向其运行报表的人员的单元格中键入名称，并让excel遍历每个报表，然后将该报表发送给选定的个人，然后循环到下一个报表.

I was wondering if there was a way to type names in cells of the people I want to run the report to and have excel loop through each one and send that report to the selected individual and then loop to the next one.

这是否可行，如果可以的话，我将如何创建该宏.

Is this possible, and if so how would I go about creating this macro.

谢谢您的帮助

推荐答案

也许您可以根据需要调整以下代码.它将把ActiveSheet上的文本框的内容发送到A列中的电子邮件列表.要使用它，您必须在Outlook中设置发送电子邮件帐户.

Perhaps you can adjust the code below for your needs. It will send the contents of a textbox on the ActiveSheet to a list of emails in column A. To use it you have to set up your sending email account in Outlook.

Option Explicit
'how to send an email to a list of recipients based on data
'stored in a workbook. The recipient email addresses must
'be in column A, and the body text of the email must be in
'the first text box on the active sheet.

Sub Sample()
   Dim olApp As Object, olMailItm As Object, i As Integer, j As Integer
   Dim r As Range, s As String, numRows As Integer, numCols As Integer
   Dim Dest As Variant, emailAddr As String, txtBox As Shape
   'Create the Outlook application and the empty email.
   Set olApp = CreateObject("Outlook.Application")
   Set olMailItm = olApp.CreateItem(0)
   Set txtBox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
   200, 100, 400, 100)
   '.TextFrame.TextRange.Text = "Test Box"
   'Using the email, add multiple recipients, using a list of addresses in column A.
   Set r = Range("B1")
   s = "": numCols = 4: numRows = 4
   For j = 1 To numCols
    For i = 1 To numRows
      If i > 1 Then s = s & vbTab
      s = s & r.Offset(j, i)
    Next i
    s = s & vbCr
   Next j
   txtBox.TextFrame2.TextRange.Characters.Text = s
   With olMailItm
       emailAddr = ""
       For i = 1 To WorksheetFunction.CountA(Columns(1))
           If emailAddr = "" Then
               emailAddr = Cells(i, 1).Value
           Else
               emailAddr = emailAddr & ";" & Cells(i, 1).Value
           End If
       Next i

    'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
       .BCC = emailAddr
       .Subject = "FYI"
       '.body = txtBox.Text
       .body = ActiveSheet.TextBoxes(1).Text
       .Send
   End With

   'Clean up the Outlook application.
   Set olMailItm = Nothing
   Set olApp = Nothing
End Sub

这篇关于VBA电子邮件循环，用于Excel报告的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！