我曾尝试编写一个宏来扫描一个文件夹，以挑选属于某个人（如AAA）的相关PDF文件，并将它们附加到一封电子邮件中发送给AAA，然后继续挑选属于BBB的PDF文件，并将它们附加到一封电子邮件中发送给BBB，依此类推。我的包含PDF文件的文件夹如下所示：

• AAA_111111.pdf
• AAA_222222.pdf
• AAA_333333.pdf
• BBB_111111.pdf
• BBB_222222.pdf
• BBB_333333.pdf
• CCC_777777.pdf
• CCC_888888.pdf
• CCC_999999.pdf
• CCC_444444.pdf

该人员由下划线（姓名首字母缩写）前的字母标识，另一个Excel选项卡上有一个列表，可对照该列表查找姓名首字母缩写以返回其电子邮件地址。
我已经写了下面的代码，它的工作相当不错，除了它有一个恼人的缺陷，我不能解决。它将成功地生成个人AAA的电子邮件，并附上上面列出的所有三个文件。在下一次通过主（外部）“do while”循环将其转到person BBB，但内部“do while mfe=”循环将附加为其列出的第二个和第三个文件（BBB_222222.pdf和BBB_333333.pdf），并完全忽略BBB_111111.pdf（不附加它），尽管它似乎可以看到它。第三个循环也是如此，“do while mfe=”循环将CCC的后三个文件附加到电子邮件中，但不会附加CCC_77777.pdf？！

Sub emailreports()
Dim OutApp As Object
Dim OutMail As Object
Dim OMail As Object, signature, mfe, sto As String
Dim emaillastrow, x, a As Long
Dim fso As Scripting.FileSystemObject
Set fso = New FileSystemObject
Dim folder, strfile As String
Dim rundate As Date

Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.AutoRecover.Enabled = False

folder = Worksheets("START").Range("A14")
strfile = Dir(folder)
rundate = Worksheets("TEMPLATE").Range("E7")
b = Worksheets("START").Range("H25")

Sheets("EMAIL").Select
emaillastrow = Worksheets("EMAIL").Range("A1000000").End(xlUp).Row

If Dir(folder, vbDirectory) = "" Then
MsgBox "PDF destination file path doesn't exist.", vbcritial, "Path error"
Exit Sub
End If

Do While Len(strfile) > 0
        Filename = fso.GetBaseName(folder & strfile)
        mfe = Left(Filename, InStr(Filename, "_") - 1)
        
        For x = 2 To emaillastrow
        If mfe = Worksheets("EMAIL").Range("A" & x) Then
        sto = sto & ";" & Worksheets("EMAIL").Range("B" & x)
        End If
        Next
        
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
        On Error Resume Next
        With OutMail
        .Display
         End With
         With OutMail
        .To = LCase(sto)
        .CC = ""
        .BCC = ""
        .Subject = "Test subject text"
        Do While mfe = Left(Filename, InStr(Filename, "_") - 1)
                .Attachments.Add (folder & Filename)
                Filename = Dir
                If Filename = "" Then
                Exit Do
                End If
        Loop
        .signature.Delete
        .HTMLBody = "<font face=""arial"" style=""font-size:10pt;"">" & "Test email body text" & .HTMLBody
        .Display
        
        End With
        On Error GoTo 0
        
        With Application
        .EnableEvents = True
        .ScreenUpdating = True
        End With
        
        Set OutMail = Nothing
        Set OutApp = Nothing
        Set OutAccount = Nothing
        
Skip:
sto = ""
strfile = Filename

Loop

Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.AutoRecover.Enabled = True
End Sub

我想尝试在邮件生成的最后退一步，但作为一个循环，这是不可能的。我的代码似乎忽略了PDF，它停止在作为前一个电子邮件生成的一部分，当生成下一个电子邮件开始从该PDF文件，但只拿起并附加后续PDF。任何帮助将感激地接收，因为我已经尝试了各种各样的事情，但不能'这是我在Stackoverflow上的第一篇文章，如果我的问题和/或格式不正确或不合适，请道歉。