收件人邮箱地址(VBA-004：收发人匹配邮箱地址)

Posted 2023-05-27

篇首语：成功由大量的失误铸就。本文由小常识网(cha138.com)小编为大家整理，主要介绍了收件人邮箱地址(VBA-004：收发人匹配邮箱地址)相关的知识，希望对你有一定的参考价值。

收件人邮箱地址(VBA-004：收发人匹配邮箱地址)

一、用户需求

1、表格介绍：

《Item》表为ID、发件人姓名、收件人姓名、邮件标题、邮件内容

《Item》

《NameList》表为ID、姓名、邮箱地址、邮箱签名

《NameList》

《Result》表为序号、发件人邮箱、收件人邮箱、邮件标题、邮件内容

《Result》

2、需求：

将《Item》表中的内容复制到《Result》表中，并将发件人姓名、收件人姓名，邮件内容的[CC]/[To]修改为对应的发件人邮箱地址、收件人邮箱地址、收发人姓名。

二、需求分析

该需求主要是数据匹配方面，但中间的难点为一行多个姓名如何去匹配、邮件内容对应匹配，因此需采用数组和字典来解决该问题，具体步骤如下：

1、设计字典dict，装载《NameList》的Name和Email，用来实现匹配姓名对应的邮箱地址；

2、设计姓名替换email的方法，具体逻辑如下：

数组arr装载《Item》表；使用split方法将To和CC的多人切换为单人数组使用字典进行匹配

3、设计邮件内容自动更换方法，使用Replace方法替换关键字

代码实现

Sub OutputResult()' 输出结果    Worksheets("Result").Activate    ActiveSheet.UsedRange.Offset(1).ClearContents    Dim arr, arr2, arr3, arr4(), dict As Object        Worksheets("NameList").Activate    arr2 = Range("b2:c" & [c9999].End(xlUp).Row)    Set dict = email(arr2)        Worksheets("Items").Activate    arr3 = Range(Cells(2, 1), Cells([e3000].End(xlUp).Row, 5))    For i = 1 To UBound(arr3, 1)        arr3(i, 5) = ReplaceContent(arr3(i, 5), arr3(i, 2), arr3(i, 3))        arr3(i, 1) = i        arr3(i, 2) = ReplaceEmail(arr3(i, 2), dict)        arr3(i, 3) = ReplaceEmail(arr3(i, 3), dict)    Next i        Worksheets("Result").Activate    [A2].Resize(UBound(arr3)) = WorksheetFunction.Index(arr3, 0, 1)    [B2].Resize(UBound(arr3)) = WorksheetFunction.Index(arr3, 0, 2)    [C2].Resize(UBound(arr3)) = WorksheetFunction.Index(arr3, 0, 3)    [E2].Resize(UBound(arr3)) = WorksheetFunction.Index(arr3, 0, 5)End SubFunction email(arr)' 生成邮件字典' arr：类型,数组    Dim dict  As Object    Set dict = CreateObject("scripting.dictionary")    For i = 1 To UBound(arr)        dict(arr(i, 1)) = arr(i, 2)    Next i    Set email = dictEnd FunctionFunction ReplaceContent(s, em, cc)' 自动替换收发人的姓名    If InStr(s, "[To]") > 0 Then        s = Replace(s, "[To]", em)    Else        s = Replace(s, "[CC]", cc)    End If    ReplaceContent = sEnd FunctionFunction ReplaceEmail(s, dict As Object)' 将姓名替换为email    Dim arr, i%, s1 As String    arr = Split(s, ";")    If UBound(arr) = -1 Then        s1 = ""    ElseIf UBound(arr) = 0 Then        s1 = dict.Item(s)    Else        For i = 0 To UBound(arr)            If i = 0 Then                s1 = dict.Item(arr(i))            Else                s1 = s1 & ";" & dict.Item(arr(i))            End If        Next i    End If    ReplaceEmail = s1End Function