发送一封电子邮件,其中包含来自不同行的内容。

huangapple go评论58阅读模式
英文:

Send an email with content from different rows

问题

我有以下的VBA代码来发送带附件的邮件。

  1. 此代码的功能:生成并发送带附件的邮件,其信息来自Excel表中不同行的数据。

  2. 我希望代码实现的功能:识别来自同一账户的交易,将它们包括在同一封邮件中。这些信息在表格的B列中。

  3. 我希望改进此代码的方式:

    1. 我想要检查B列中所有单元格的数值,看是否有来自同一账户的交易,将它们包括在同一封邮件中,而不是分开发送。

    2. 我认为需要对代码的以下部分进行修改:

      • 如果一封邮件中有多笔交易,交易摘要部分应相应重复。
      • 如果一封邮件中有多笔交易,附件部分也应相应修改。附件部分需要相应修改。

一些重要的列:

  • B:账户号码
  • O:附件文件名

完整代码:(代码部分不进行翻译,仅返回注释部分的中文翻译)

英文:

I have the below VBA code to send emails with attachment.

  1. What this code does: Generates and sends emails with attachment, whose information is from separate rows in the Excel table.

  2. What I want the code to do: Recognise transactions from the same account to include in one email. This information is in column B of the table.

  3. How I want this code to be improved:

    1. I want to check all cell values in column B to see if there are any transactions coming from the same account to include them in the same email instead of sending them separately.

    2. I think the changes must be made to these parts of the code:

      • If there is more than one transaction in one email, the transaction summary part should repeat correspondingly.
      • If there is more than one transaction in one email, there should also be more than one attachment. The attachment part would need to be modified accordingly.

Some important columns:

  • B: Account number

  • O: Attachment file name

The full code:

Sub SendEmail_Dispute()
' email processing

For i = 2 To Sheet2.Range("A" & Rows.Count).End(xlUp).Row
Dim EmailApp As Outlook.Application
Dim Source As String
Set EmailApp = New Outlook.Application

Dim EmailItem As Outlook.MailItem
Set EmailItem = EmailApp.CreateItem(olMailItem)

EmailItem.To = "abc@gmail.com"
EmailItem.Subject = "#" & Sheet2.Range("B" & i).Value & " - " & Sheet2.Range("M" & i).Value & ": " & Sheet2.Range("S" & i).Value

'[Transaction Summary Part] (starting at "------Transaction Summary-------")

EmailItem.HTMLBody = "Dear our valued customer, " & "<br>" & "<br>" & "We have registered a suspicious transaction from your account with number: " & "<b>" & Sheet2.Range("G" & i).Value & " - " & Sheet2.Range("H" & i).Value & "</b>" & ". The information is as follows: " & "<br>" & "<br>" & _
"------Transaction Summary-------" & "<br>" & "<br>" & _
"<table>" & _
"<table border='1' cellspacing='0' cellpadding=4'>" & _
"<tr><td><b> Transaction ID: </b></td><td>" & Sheet2.Range("C" & i).Value & "</td><td>" & Sheet2.Range("M" & i).Value & "</td></tr>" & _
"<tr><td><b> Transaction Amount: </b></td><td>" & Sheet2.Range("K" & i).Value & "</td><td>" & Sheet2.Range("T" & i).Value & " " & Sheet2.Range("W" & i).Value & "</td></tr>" & _
"<tr><td><b> Transaction Date: </b></td><td>" & Sheet2.Range("J" & i).Value & "</td><td>" & Sheet2.Range("U" & i).Value & "</td></tr>" & _
"</table>" & _
"<br>" & "<br>" & _
"Thank you" & "<br>" & "Best regards,"

'[Attachment Part]

'Source = ThisWorkbook.FullName
'---------Attachment
Dim fso As Scripting.FileSystemObject
Set fso = New FileSystemObject
Dim file As Scripting.file
Dim folder As Scripting.folder
Set folder = fso.GetFolder("C:\Users\main\Desktop\sus trx")
'Source = "C:\test"
For Each file In folder.Files
    If Sheet2.Range("O" & i).Value = fso.GetBaseName(file.Name) Then

        EmailItem.Attachments.Add file.Path
        Exit For
        
    End If
Next file

EmailItem.Send
Next i
End Sub

答案1

得分: 0

Here is the translated code:

尝试

    Sub SendEmails()
        
        Dim Applications As Object
        Dim Applications_Item As Object
        Dim Blist As Range
        Dim bAcct As Range, xcell As Range, HtmlContent, firstAddress
        Dim Key As Variant
        Dim lastRow As Long
        Dim dict
        Dim attPath As String
        Dim subjectMS, bodyGS 
        
        Set Applications = CreateObject("Outlook.Application")
        
        lastRow = Sheet2.Cells(Rows.Count, "B").End(xlUp).Row
        Set Blist = Sheet2.Range("B2:B" & lastRow)
    
        Set dict = CreateObject("Scripting.Dictionary")
        For Each xcell In Blist
            If Not dict.Exists(CStr(xcell.Value)) Then
                dict.Add CStr(xcell.Value), 1        '将帐号号码转换为字符串以用于字典
            End If
        Next xcell
        
        For Each Key In dict.Keys
        
            Set bAcct = Blist.Find(Key, LookIn:=xlValues)
            If Not bAcct Is Nothing Then
                Set Applications_Item = Applications.CreateItem(0)
                firstAddress = bAcct.Address
                Do
                    HtmlContent = HtmlContent & "<table>" & _
                                  "<table border='1' cellspacing='0' cellpadding='4'>" & _
                                  "<tr><td><b>交易ID:</b></td><td>" & Sheet2.Range("C" & bAcct.Row).Value & _
                                  "</td><td>" & Sheet2.Range("M" & bAcct.Row).Value & "</td></tr>" & _
                                  "<tr><td><b>交易金额:</b></td><td>" & Sheet2.Range("K" & bAcct.Row).Value & "</td><td>" & _
                                  Sheet2.Range("T" & bAcct.Row).Value & " " & Sheet2.Range("W" & bAcct.Row).Value & "</td></tr>" & _
                                  "<tr><td><b>交易日期:</b></td><td>" & Sheet2.Range("J" & bAcct.Row).Value & "</td><td>" & _
                                  Sheet2.Range("U" & bAcct.Row).Value & "</td></tr>" & _
                                  "</table>" & "<br>"
                                            
                    '附件
                    attPath = "C:\Users\main\Desktop\sus trx\"
                    Applications_Item.Attachments.Add attPath & Sheet2.Range("O" & bAcct.Row).Value
                    
                    ' 将列M-S的值附加到主题和列G-S的值附加到正文
                    subjectMS = subjectMS & ", " & Sheet2.Range("M" & bAcct.Row).Value & ":" & Sheet2.Range("S" & bAcct.Row).Value
                    bodyGS = bodyGS & ", " & Sheet2.Range("G" & bAcct.Row).Value & " - " & Sheet2.Range("H" & bAcct.Row).Value
                    
                    Set bAcct = Blist.FindNext(bAcct)
                Loop While Not bAcct Is Nothing And bAcct.Address <> firstAddress
            End If
            
            With Applications_Item
                .To = "abc@gmail.com"
                '.CC
                .Subject = "#" & Sheet2.Range("B" & bAcct.Row).Value & " - " & Mid(subjectMS, 2)
                .HTMLBody = "亲爱的尊贵客户," & "<br>" & "<br>" & "我们已经登记了您帐号上的可疑交易: " & _
                            "<b>" & Mid(bodyGS, 2) & "</b>" & _
                            ". 信息如下: " & "<br>" & "<br>" & "------交易摘要-------" & "<br>" & "<br>" & _
                            HtmlContent & "<br>" & "<br>" & "谢谢您" & "<br>" & "此致敬礼,"
                .Display   '测试后注释掉并使用 .send
                '.Send
            End With
            HtmlContent = ""
            subjectMS = ""
            bodyGS = ""
        Next Key
                
        Set Applications = Nothing
        Set Applications_Item = Nothing
        Set dict = Nothing
    
    End Sub

I've translated the code as requested.

英文:

try

Sub SendEmails()
    
    Dim Applications As Object
    Dim Applications_Item As Object
    Dim Blist As Range
    Dim bAcct As Range, xcell As Range, HtmlContent, firstAddress
    Dim Key As Variant
    Dim lastRow As Long
    Dim dict
    Dim attPath As String
    Dim subjectMS, bodyGS 
    
    Set Applications = CreateObject(&quot;Outlook.Application&quot;)
    
    lastRow = Sheet2.Cells(Rows.Count, &quot;B&quot;).End(xlUp).Row
    Set Blist = Sheet2.Range(&quot;B2:B&quot; &amp; lastRow)

    Set dict = CreateObject(&quot;Scripting.Dictionary&quot;)
    For Each xcell In Blist
        If Not dict.Exists(CStr(xcell.Value)) Then
            dict.Add CStr(xcell.Value), 1        &#39;CStr convert to account number to string for the dictionary
        End If
    Next xcell
    
    For Each Key In dict.Keys
    
        Set bAcct = Blist.Find(Key, LookIn:=xlValues)
        If Not bAcct Is Nothing Then
            Set Applications_Item = Applications.CreateItem(0)
            firstAddress = bAcct.Address
            Do
                HtmlContent = HtmlContent &amp; &quot;&lt;table&gt;&quot; &amp; _
                              &quot;&lt;table border=&#39;1&#39; cellspacing=&#39;0&#39; cellpadding=4&#39;&gt;&quot; &amp; _
                              &quot;&lt;tr&gt;&lt;td&gt;&lt;b&gt; Transaction ID: &lt;/b&gt;&lt;/td&gt;&lt;td&gt;&quot; &amp; Sheet2.Range(&quot;C&quot; &amp; bAcct.Row).Value &amp; _
                              &quot;&lt;/td&gt;&lt;td&gt;&quot; &amp; Sheet2.Range(&quot;M&quot; &amp; bAcct.Row).Value &amp; &quot;&lt;/td&gt;&lt;/tr&gt;&quot; &amp; _
                              &quot;&lt;tr&gt;&lt;td&gt;&lt;b&gt; Transaction Amount: &lt;/b&gt;&lt;/td&gt;&lt;td&gt;&quot; &amp; Sheet2.Range(&quot;K&quot; &amp; bAcct.Row).Value &amp; &quot;&lt;/td&gt;&lt;td&gt;&quot; &amp; _
                              Sheet2.Range(&quot;T&quot; &amp; bAcct.Row).Value &amp; &quot; &quot; &amp; Sheet2.Range(&quot;W&quot; &amp; bAcct.Row).Value &amp; &quot;&lt;/td&gt;&lt;/tr&gt;&quot; &amp; _
                              &quot;&lt;tr&gt;&lt;td&gt;&lt;b&gt; Transaction Date: &lt;/b&gt;&lt;/td&gt;&lt;td&gt;&quot; &amp; Sheet2.Range(&quot;J&quot; &amp; bAcct.Row).Value &amp; &quot;&lt;/td&gt;&lt;td&gt;&quot; &amp; _
                              Sheet2.Range(&quot;U&quot; &amp; bAcct.Row).Value &amp; &quot;&lt;/td&gt;&lt;/tr&gt;&quot; &amp; _
                              &quot;&lt;/table&gt;&quot; &amp; &quot;&lt;br&gt; &quot;
                                        
                &#39;Attachment
                attPath = &quot;C:\Users\main\Desktop\sus trx\&quot;
                Applications_Item.Attachments.Add attPath &amp; Sheet2.Range(&quot;O&quot; &amp; bAcct.Row).Value
                
                &#39; append values of columns M-S to subject and G-S to body
                subjectMS = subjectMS &amp; &quot;, &quot; &amp; Sheet2.Range(&quot;M&quot; &amp; bAcct.Row).Value &amp; &quot;:&quot; &amp; Sheet2.Range(&quot;S&quot; &amp; bAcct.Row).Value
                bodyGS = bodyGS &amp; &quot;, &quot; &amp; Sheet2.Range(&quot;G&quot; &amp; bAcct.Row).Value &amp; &quot; - &quot; &amp; Sheet2.Range(&quot;H&quot; &amp; bAcct.Row).Value
                
                Set bAcct = Blist.FindNext(bAcct)
            Loop While Not bAcct Is Nothing And bAcct.Address &lt;&gt; firstAddress
        End If
        
        With Applications_Item
            .To = &quot;abc@gmail.com&quot;
            &#39;.CC
            .Subject = &quot;#&quot; &amp; Sheet2.Range(&quot;B&quot; &amp; bAcct.Row).Value &amp; &quot; - &quot; &amp; Mid(subjectMS, 2)
            .HTMLBody = &quot;Dear our valued customer, &quot; &amp; &quot;&lt;br&gt;&quot; &amp; &quot;&lt;br&gt;&quot; &amp; &quot;We have registered a suspicious transaction from your account with number(s): &quot; &amp; _
                        &quot;&lt;b&gt;&quot; &amp; Mid(bodyGS, 2) &amp; &quot;&lt;/b&gt;&quot; &amp; _
                        &quot;. The information is as follows: &quot; &amp; &quot;&lt;br&gt;&quot; &amp; &quot;&lt;br&gt;&quot; &amp; &quot;------Transaction Summary-------&quot; &amp; &quot;&lt;br&gt;&quot; &amp; &quot;&lt;br&gt;&quot; &amp; _
                        HtmlContent &amp; &quot;&lt;br&gt;&quot; &amp; &quot;&lt;br&gt;&quot; &amp; &quot;Thank you&quot; &amp; &quot;&lt;br&gt;&quot; &amp; &quot;Best regards,&quot;
            .Display   &#39;comment out and use .send after testing
            &#39;.Send
        End With
        HtmlContent = &quot;&quot;
        subjectMS = &quot;&quot;
        bodyGS = &quot;&quot;
    Next Key
            
    Set Applications = Nothing
    Set Applications_Item = Nothing
    Set dict = Nothing

End Sub

huangapple
  • 本文由 发表于 2023年5月7日 14:02:16
  • 转载请务必保留本文链接:https://go.coder-hub.com/76192413.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定