VBA Parsen E-Mail Header Routing (Hops) Daten

Question

Ich bin daran interessiert, mit VBA/VBscript E-Mail-Header-Daten zu analysieren. Es gibt andere Antworten auf dieser Seite, die das zu einem gewissen Grad ansprechen, jedoch nicht in dem Maße, wie ich es brauche.

Ich habe eine Reihe von Nachrichtenheadern, die ich aus E-Mails extrahiert und als Textdateien gespeichert habe, alles in einem Ordner (siehe Bild unten). Ich möchte den Ordner durchlaufen und den in der Box angegebenen Bereich analysieren (vielleicht in Excel speichern oder eine Tabelle in Access?). Die Daten, die in der Box angegeben sind, zeigen alle E-Mail "Hops" (wenn eine E-Mail gesendet wird, wird sie zwischen vielen Computern übertragen - jede Übertragung ist ein "Hop"). Diese Daten werden in dem gefunden „Received: from“ weiter unten hervorgehoben:

* HINWEIS: Entschuldigt, ich bin nicht auf einen Ruf als der noch Bilder schreiben:

https://msdnshared.blob.core.windows.net/media/TNBlogsFS/prod.evol.blogs.technet.com/CommunityServer.Blogs.Components.WeblogFiles/00/00/00/76/18/3782.HSG-8-18-11-1.jpg

Das Ergebnis sollte wie folgt aussehen:

https://msdnshared.blob.core.windows.net/media/TNBlogsFS/prod.evol.blogs.technet.com/CommunityServer.Blogs.Components.WeblogFiles/00/00/00/76/18/7624.hsg-8-19-11-1.png

Dies wird erreicht durch die FROM, BY, mIT und DATESTAMP Informationen aus dem oben eingerahmten Bereich des Message-Header-Parsing.

Art von einem großen Auftrag, ich weiß. Aber ich kann scheinbar nichts online finden. Jede Hilfe (oder Anweisung zu anderen Lösungen) wäre willkommen.

Vielen Dank.

Answer 1

Versuchen Sie diesen Code und lassen Sie mich wissen, ob es für Sie funktioniert oder nicht. Sie müssen nur den Pfad des Ordners angeben, der alle Ihre Textdateien enthält. Der Code würde die Ausgabe in einer Datei "1.txt" innerhalb desselben Ordners speichern. Alle Werte in der Datei werden durch Doppel-Pipe (||) getrennt. Selbstverständlich können Sie es später entsprechend Ihrer Anforderung ändern.

Dim objFso, strFolderPath, objFolder, file, workFile, tempArr, strAllData 
Dim strRecordData, arrRecordData 
strFolderPath = "C:\Users\gu.singh\Desktop\Desktop\Gurman\2017\5. May\aa" 'REPLACE THIS PATH WITH YOUR FOLDER PATH 
Set objFso = CreateObject("Scripting.FileSystemObject") 
If objFso.FolderExists(strFolderPath) Then 
    Set objFolder = objFso.GetFolder(strFolderPath) 
    For Each file In objFolder.Files 
     tempArr = Split(file.Name,".") 
     If StrComp(tempArr(UBound(tempArr)),"txt",1)=0 Then 
      Set workFile = file.OpenAsTextStream(1) 
      strAllData = workFile.ReadAll() 
      workFile.Close 
      arrRecordData = Split(strAllData,"Received:") 
      For i=1 To UBound(arrRecordData) Step 1 
       intby = InStr(1,arrRecordData(i),"by ",1) 
       intfrom = InStr(1,arrRecordData(i),"from ",1) 
       intwith = InStr(1,arrRecordData(i),"with ",1) 
       intsemi = InStr(1,arrRecordData(i),";",1) 
       intdash = InStr(1,arrRecordData(i),"-",1) 
       strFROM = Trim(Mid(arrRecordData(i),intfrom+Len("from "), intby-intfrom-Len("from "))) 
       strBY = Trim(Mid(arrRecordData(i),intby+Len("by "), intwith-intby-Len("by "))) 
       strWITH = Trim(Mid(arrRecordData(i),intwith+Len("with "), intsemi-intwith-Len("with "))) 
       strDATE = Trim(Mid(arrRecordData(i),intsemi+Len(";"), intdash-intsemi-Len(";"))) 
       strResult = strResult & strBY &"||"&strFROM&"||"&strWITH&"||"&strDATE&vbCrLf 
      Next 

      Set WorkFile = Nothing 
     End If 
    Next 
    Set objFolder = Nothing 
End If 
Set fyl = objFso.OpenTextFile(strFolderPath&"\1.txt",2,True) 
fyl.Write strResult 
fyl.Close 
Set fyl=Nothing 
Set objFso = Nothing