単一の電子メール情報を破棄し、すべてのメールを取得します

Question

私はチェーンメールに含まれるすべての件名を取得したいと思います。

シナリオ：誰かがすべてに返信した後、他の人が全員に返信した人からメールが届きました（10人がそれを受け取ったとします）。だから私が受け取った最後か最後のメールには3つのメールが1つのメールにまとめられます。親のメール、2つの返信。私が望むのは、その電子メールに返信した人の情報を1番目と2番目に返信し、その返信を得ることです。あるいは、もし私たちが3つの別々の電子メールにその電子メールを壊すことができれば。始める場所をお勧めします。

Answer 1

は、私が「件名」検索、タブによって、それを分割した後、配列に電子メールの本文を渡すことによって、それを行うための方法を発見しました。私が使用したコードは以下です。

このコードでは、選択したメールをピックアップして渡します。

Set olapp = GetObject(, "Outlook.Application") 
Set olmail = olapp.ActiveExplorer.Selection(1) 



msg_body = Split(olmail.Body, Chr(13)) 

MsgBox UBound(msg_body) 

For i = 0 To UBound(msg_body) 

If InStr(msg_body(i), "Subject:") <> 0 Then 
MsgBox msg_body(i) 
End If 
Next i 

チェーン内にいくつのメールがあるかを特定するために、それらの数を印刷したり、使用したりすることができます。

Answer 2

次のコードがテストされています。 これは、引数としてMailItemをとり、 を受け取り、件名を含む配列を返します。その中でループにそれを渡すことによって：

Function ReturnSubjects(o As Outlook.MailItem) As Variant 

Dim v As Variant, b As String, i As Integer, ii As Integer, y As Integer 
ReDim v(1 To 1, 1 To 1) 
y = 1 
v(1, 1) = o.Subject 

b = o.Body 

i = InStr(b, "Subject: ") 

Do While i > 0 

    ii = InStr(Mid(b, i), vbCrLf) 
    If ii = 0 Then Exit Do 


    y = y + 1 
    ReDim Preserve v(1 To 1, 1 To y) 

    v(1, y) = Mid(b, i, ii) 
    b = Mid(b, i + ii) 
    i = InStr(b, "Subject: ") 

Loop 

ReturnSubjects = v 

End Function