Outlook/Excel集成？

Question

我有以下问题。我使用MSword邮件合并发送电子邮件。我经常发送100-500封电子邮件（不是垃圾邮件，单数请求）。我将我的电子邮件地址保存在一张MSexcel表单中。许多电子邮件地址被破坏，大多数回复都是消极的。许多电子邮件回复是在发送电子邮件的前30分钟内发出的。收到回复后，我需要在Excel列表中标记回复。这个过程可能非常耗时。因此，这个问题。现在，这个问题。

有没有办法使我的电脑检查我的电子邮件的主题行是否为指定的字符串，如果它包含该字符串，那么它会从该电子邮件中复制电子邮件地址，无论是在电子邮件的正文中，还是在发件人字段中，然后移至指定的Excel表格，在Excel表格中搜索电子邮件地址，然后在Excel表格中标记电子邮件地址。

非常高兴任何人都可以指出我在正确的方向。我绝对没有编程经验。我一生都在使用电脑，但主要是发送和接收电子邮件，或浏览互联网。

Answer 1

您可以从Excel中直接使用，这是你想要的东西有点大材小用，但如果你不需要他们，你可以删除字段：

'********************************************************************************************* 
' All code is supplied under the Creative Commons License (CC). Code samples provided by 
' Wilde XL Solutions are strictly for non-commerical use only and provided for the purpose 
' learning and study. If you would like to seek permission to use this code in any way other 
' than specified in this license agreement, please email [email protected] 
' 
' A copy of the general creative commons (CC) license can be found at: 
' http://tinyurl.com/WXLSCCinfo 
'********************************************************************************************* 

Sub getMail() 

     ' This sub is designed to be used with a blank worksheet. It will create the header 
     ' fields as required, and continue to populate the email data below the relevant header. 

     ' Declare required variables 
     '------------------------------------------------------------- 
    Dim olApp As Object 
    Dim olFolder As Object 
    Dim olMailItem As Object 

    Dim strTo As String 
    Dim strFrom As String 
    Dim dateSent As Variant 
    Dim dateReceived As Variant 
    Dim strSubject As String 
    Dim strBody As String 

    Dim loopControl As Variant 
    Dim mailCount As Long 
    Dim totalItems As Long 
     '------------------------------------------------------------- 

     'Turn off screen updating 
    Application.ScreenUpdating = False 

     'Setup headers for information 
    Range("A1:F1").Value = Array("To", "From", "Subject", "Body", "Sent (from Sender)", "Received (by Recipient)") 

     'Format columns E and F to 
    Columns("E:F").EntireColumn.NumberFormat = "DD/MM/YYYY HH:MM:SS" 

     'Create instance of Outlook 
    Set olApp = CreateObject("Outlook.Application") 

     'Select folder to extract mail from 
    Set olFolder = olApp.GetNamespace("MAPI").PickFolder 

     'Get count of mail items 
    totalItems = olFolder.items.Count 
    mailCount = 0 

     'Loop through mail items in folder 
    For Each loopControl In olFolder.items 

      'If loopControl is a mail item then continue 
     If TypeName(loopControl) = "MailItem" Then 

       'Increase mailCount 
      mailCount = mailCount + 1 

       'Inform user of item count in status bar 
      Application.StatusBar = "Reading email no. " & mailCount & " of " & totalItems 

       'Get mail item 
      Set olMailItem = loopControl 

       'Get Details 
      With olMailItem 
       strTo = .To 
        'If strTo begins with "=" then place an apostrophe in front to denote text format 
       If Left(strTo, 1) = "=" Then strTo = "'" & strTo 
       strFrom = .Sender 
        'If sender displays name only, show name followed by email address e.g.(Bloggs, Joe <[email protected]>) 
       If InStr(1, strFrom, "@") < 1 Then strFrom = strFrom & " - < " & .SenderEmailAddress & " >" 
       dateSent = .SentOn 
       dateReceived = .ReceivedTime 
       strSubject = .Subject 
       strBody = .Body 
      End With 

       'Place information into spreadsheet 
       'import information starting from last blank row in column A 
      With Range("A" & Rows.Count).End(xlUp).Offset(0, 0) 
       .Value = strTo 
       .Offset(1, 1).Value = strFrom 
       .Offset(2, 2).Value = strSubject 

        'Check for previous replies by looking for "From:" in the body text 
        'Check for the word "From:" 
       If InStr(0, strBody, "From:") > 0 Then 
         'If exists, copy start of email body, up to the position of "From:" 
        .Offset(1, 1).Value = Mid(strBody, 1, InStr(1, strBody, "From:") - 1) 
       Else 
         'If doesn't exist, copy entire mail body 
        .Offset(3, 3).Value = strBody 
       End If 

       .Offset(4, 4).Value = dateSent 
       .Offset(5, 5).Value = dateReceived 

      End With 

       'Release item from memory 
      Set olMailItem = Nothing 

     End If 

      'Next Item 
    Next loopControl 

     'Release items from memory 
    Set olFolder = Nothing 
    Set olApp = Nothing 

     'Resume screen updating 
    Application.ScreenUpdating = True 

     'reset status bar 
    Application.StatusBar = False 

     'Inform user that code has finished 
    MsgBox mailCount & " messages copied successfully.", vbInformation, "Complete" 

End Sub