Email outlook电子邮件的收件人列表（收件人和抄送人）

我有一个脚本，在CSV文件中列出符合outlook规则的电子邮件

现在它列出了： 现在,， 保存电子邮件的Outlook文件夹， 电子邮件类别， 收到时间， 发件人代码， 发件人电子邮件， 主题,， 抄送姓名（&C）， 附件:， 正文（纯文本）

我的问题是To&CC。我想收到电子邮件，而不是姓名，就像我对发件人所做的那样，但还没有做到这一点。 有人能帮忙吗

我在下面附上我的代码和我得到的结果（以及我想要的结果）的示例

我得到的一个结果样本是：

#2020-09-18 13:39:27；“Fldr：收件箱工程”；“注册”；200918-121900;“测试”；“发件人：VMERS@TESTCOMPANY.COM";“关于：文件领域1”；“收件人：史密斯；约翰-抄送：桑德斯；艾琳娜”；“收件人：无”；“嗨，约翰，等等……” #2020-09-18 13:39:27#;“Fldr：收件箱工程”；“注册”；200918-123900;“恩特”；“发件人：IRENA@ENTERPRISE.COM";“关于：文件领域1”；致：史密斯；约翰；‘维克多·默斯’-抄送：“；“附件：图像/徽标”；“呜呜呜呜……” #2020-09-18 13:39:32#;“Fldr:已发送”；；200918-130800;“拖”；“发件人：公司JSMITH1”；“关于：第1区附表草案”；致：'维克多·默斯'；桑德斯；伊雷娜；艾娜·纳尔逊-抄送：'；“附件：附表A v01.PDF；IMG_5989.jpg+IMG/Logo”；“呜呜呜呜……”

因此，我得到：

“收件人：史密斯；约翰-抄送：桑德斯；艾琳娜”

致：史密斯；约翰；'VICTOR MERS'-CC:

致：维克多·默斯；桑德斯；艾琳娜·纳尔逊-抄送：

我想得到：

“至：JSMITH1@MYCOMPANY.COM-抄送：IRENA@ENTERPRISE.COM"

“至：JSMITH1@MYCOMPANY.COM; VMERS@TESTCOMPANY.COM-CC:“

“至：VMERS@TESTCOMPANY.COM; IRENA@ENTERPRISE.COMA.NELSON@TESTCOMPANY.COM-CC:“

提前谢谢你的帮助

---

SAI

使用

收件人

集合，循环遍历所有收件人，并为每个收件人读取

收件人.姓名

和

收件人.地址

属性，而不是使用

收件人

抄送属性。要区分收件人类型，请检查

recipient.Type

属性（

olTo

/

olCC

/

olBCC

）

请记住，对于前收件人，您将获得前类型地址，而不是SMTP。在这种情况下，您需要访问

Recipient.AddressEntry.Type

属性，如果它是“EX”，则使用

Recipient.AddressEntry.GetExchangeUser（）.PrimarySmtpAddress

属性

Option Explicit
Const TextFileNPath As String = "D:\Email Register\Emails.txt"


Sub ListEmailsDataCSV(Item As Outlook.MailItem)

    Dim sReceived As String
    Dim sSubj As String
    Dim sSenderCode As String
    Dim sFrom As String
    Dim sTo As String
    Dim sCC As String
    Dim sAttach As String
    Dim sBody As String
    Dim sCategory As String
        
    Dim FF As Long
    Dim objAtt As Outlook.Attachment
    Dim fileEXT As String
    Dim bImages As Boolean
    Dim iCounter As Integer
    

ItemReceived:
    sReceived = Format$(Item.ReceivedTime, "yymmdd-hhnnss")
     
ItemSubject:

    sSubj = Item.Subject
    sSubj = CleanString(sSubj)
    
ItemFrom:

    sFrom = UCase(Item.SenderEmailAddress)
    
    If InStr(1, sFrom, "ADMINISTRATIVE GROUP") > 0 Then
        sSenderCode = "DRAG"
        sFrom = "Corp. " & Right(sFrom, Len(sFrom) - InStrRev(sFrom, "="))
        GoTo ItemTo
    Else
        sSenderCode = UCase(Mid(sFrom, InStr(1, sFrom, "@") + 1, 4))
    End If
    
ItemTo:

    sTo = CleanString(UCase(Item.To))

ItemCC:

    sCC = CleanString(UCase(Item.CC))

ItemAttach:

    iCounter = 0
    fileEXT = ""
    sAttach = "None"
    
    If Item.Attachments.Count = 0 Then GoTo ItemBody
    
    For Each objAtt In Item.Attachments

        fileEXT = UCase(Right(objAtt.FileName, 3))
        
        If InStr(1, UCase(objAtt.FileName), "IMAGE") > 0 Then
            If fileEXT = "JPG" Or fileEXT = "PNG" Or fileEXT = "GIF" Or fileEXT = "BMP" Then
                bImages = True
                GoTo NextAttach
            End If
        End If
   
        iCounter = iCounter + 1
   
        If iCounter = 1 Then
            sAttach = objAtt.FileName  'DisplayName
        Else
            sAttach = sAttach & "; " & objAtt.FileName  'DisplayName
        End If
        
NextAttach:

    Next objAtt
    
    If iCounter = 0 Then
        sAttach = "Images/logos"
    Else
        If bImages Then sAttach = sAttach & "; +Img/Logo"
    End If
    
    sAttach = CleanString(sAttach)
    
ItemBody:

    sBody = Item.Body
    sBody = CleanString(sBody)
CleanEntersBody:

    sBody = CleanDUPL(sBody)
    If InStr(1, sBody, "  ") > 0 Then GoTo CleanEntersBody
    If InStr(1, sBody, " |") > 0 Then GoTo CleanEntersBody
    If InStr(1, sBody, "||") > 0 Then GoTo CleanEntersBody

MailCategory:

    sCategory = Item.Categories

OutputFile:

    FF = FreeFile()
    Open TextFileNPath For Append As #FF

   'Write #FF, "Export Started", "Received", "Sender Code", "Subject", "Sender", "To", "CC", "Attachments", "Body"
    Write #FF, Now, "Fldr: " & Item.Parent, sCategory, sReceived, sSenderCode, "From: " & sFrom, sSubj, "To: " & sTo & " - CC: " & sCC, "Att: " & sAttach, sBody
    Close #FF

End Sub


Function CleanString(sString As String) As String
    sString = Replace(sString, Chr(10), "|") ' Char 10 = ENTER "new Line"
    sString = Replace(sString, Chr(13), "|") ' Char 13 = ENTER "Return" (a normal ENTER is Chr10 + Chr13)
    sString = Replace(sString, Chr(9), " ")  ' Char 9 = TAB
    
    sString = Replace(sString, Chr(34), "'")  ' Char 34 = "
    
    sString = Replace(sString, ",0", ".0")
    sString = Replace(sString, ",1", ".1")
    sString = Replace(sString, ",2", ".2")
    sString = Replace(sString, ",3", ".3")
    sString = Replace(sString, ",4", ".4")
    sString = Replace(sString, ",5", ".5")
    sString = Replace(sString, ",6", ".6")
    sString = Replace(sString, ",7", ".7")
    sString = Replace(sString, ",8", ".8")
    sString = Replace(sString, ",9", ".9")
    
    sString = Replace(sString, ",", ";")
    
    CleanString = sString
End Function

Function CleanDUPL(sString As String) As String 'used recursive to clean duplicates
    sString = Replace(sString, " |", "|")
    sString = Replace(sString, "||", "|")
    sString = Replace(sString, "  ", " ")
    CleanDUPL = sString
End Function