Question

我有一张Excel表格（让我们称之为＆＃34; Sheet2＆＃34;），让我们在[A]栏中说出200个名字，在旁边的栏目中列出名称的附件它[B]。

还有另一张表（＆＃34; Sheet1＆＃34;），其中包含每个名称的邮件地址。重要！ - ＆GT;此Sheet1列表比具有200个名称的第一个列表长。

看来，Sheet＆＃34; Sheet2＆＃34;中有重复的条目。（[A]栏）但附件不同。

我想只为用户发送一封带有所有必要附件的邮件，不知何故我无法这样做......

我获得的循环为列表中的每个用户创建邮件＆＃34; Sheet1＆＃34;，但我只需要列表中用户的邮件＆＃34; Sheet2＆＃34;。

希望在这里找到答案。谢谢！

我的代码：

Sub Mails()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim FileName As Variant
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim wksDest As Worksheet


Set wksDest = ThisWorkbook.Worksheets("Sheet2")
Set wksSource = ThisWorkbook.Worksheets("Sheet1")

Dim LastRowSource As Long
LastRowSource = wksSource.Cells(wksSource.Rows.Count, "A").End(xlUp).Row

Dim LastRowDest As Long
LastRowDest = wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Row

For i = 1 To LastRowSource

    Dim OutApp As Object
    Dim OutMail As Object
    Dim CC As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Dim TC_User As String
    Dim TC_Attachement As String
    Dim TC_File As String

    TC_User = ""
    CC = ""
    TC_User = wksSource.Range("A" & i)
    TC_USer_mail = wksSource.Range("B" & i)
    TC_Attachement = ""

        With OutMail
            .To = TC_USer_mail
            .BCC = ""
            .Importance = 2
            .Subject = "for you"
            .HTMLBody = "<body style='font-family:arial;font-size:13'>" & _
                        "<b>############################################<br>" & _
                        "Diese Mail wurde automatisch erstellt<br>" & _
                        "############################################</b><br><br>" & _
                            "Hallo " & TC_User & "," & "<br><br>" & _
                            "blabla.<br><br>" & _
                        "</body>"
            For g = 2 To LastRowDest
                If wksDest.Range("A" & g) = TC_User Then

                    TC_File = wksDest.Range("B" & g)
                    TC_Attachement = "C:\Users\bla\Documents" & "\" & TC_File

                    If Dir(TC_Attachement) <> "" Then
                        .Attachments.Add TC_Attachement
                        'GoTo nextvar

                        Else
                    End If
                End If
'nextvar:
            Next g

        .Display
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
Next i

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Ende:

End Sub

Answer 1

好的，我找到了解决办法。也许它并不那么优雅，但它确实有效。我在＆＃34; With OutMail＆＃34;之前写了这段代码。 - 声明。这将检查邮件数据库中的用户ID是否实际位于包含收件人的列表中，如果不是，则此用户ID将被删除。

    For j = 2 To LastRowSource
        If TC_User = wksDest.Range("A" & j) Then
            GoTo weiter_j
        End If
    Next j
GoTo Ende:

weiter_j:

Answer 2

因此，每个名称（即，不一定是）都有未知数量的附件，您需要将它们组合在一起吗？（这听起来像是一次性的事情？）

只需将一个表格复制并粘贴到另一个下方，以便名称列排成一行，然后只需对列表进行排序（Data→Sort），然后名称将组合在一起。

从这里可以通过几种方法安排列表以自动执行发送过程。通过它的声音，大多数名字都有一个附件，所以发送你想要的那些，并手动发送其他的。

手动处理一次性任务通常比尝试自动化更快更容易。

如果这将是一个重复的任务，那么尝试找一种更好的方法来组织源数据（就像一个简单的Access表。）

（VBA）发送带有多个附件的邮件，列表

2 个答案: