Daten aus txt Datei zu Excel oä

edelheizer

Hallo liebe Nerds,....
vllt gibt es ja unter euch jemanden, der mir weiterhelfen kann. Und zwar kamm man sich bei uns in der Firma über eine Intranetseit über eine Eingabemaske zu kursen Anmelden. Die Anmeldedaten bekome ich per Email.
Die Daten jetzt aus der Email in eine Excel Liste zu übertragen, ist eine Aufgabe für jemanden der Vadder und Mudder erschlagen hat und ist verlorene Lebenszeit.
Ich habe die möglichkeit, die EMAils zu einer Texdatei zu extrahieren.
Ist es irgendwie möglich die Daten aus der Textdatei in einer Excelliste zu übergeben und zu speichern?

Hier der Code:

Spoiler anzeigen

Code

Received: 
$MessageID:  
Received:  
Received:  
SendTo: 
From:  
Subject:   
ReplyTo:  
PostedDate:  
$MIMETrack:  
$INetOrig:  
$Created: 
TNEFEvaluated:  
HasSafeStamp:  
RouteServers:  
RouteTimes:  
$Orig:  
MailFwdBy:  
$AssistMail:  
Auto-submitted:  
DeliveryReport:  
SMTPOriginator:  
$UpdatedBy:  
Categories:  
$Revisions:  
$MsgTrackFlags:  
DeliveredDate:  
DisplayCopyTo_Icon: 
$FolderRef:  
$FolderRefID:  
$FolderRefFlags: 
$Abstract:  


Body:  Abteilung: Nord
Name: Kannix
Vorname: Ich
Personalnummer: 100M7927
Einheit: ZEN
Erreichbarkeit (LoNo): Ichkannix@xxxxx.org
Bemerkungen  (Bei mehreren Teilnehmern bitte alle Teilnehmer hier 
aufführen):
Termin: 22.03.2022 (Di) Nachmittag


Received: 
$MessageID:  
Received:  
Received:  
SendTo: 
From:  
Subject:   
ReplyTo:  
PostedDate:  
$MIMETrack:  
$INetOrig:  
$Created: 
TNEFEvaluated:  
HasSafeStamp:  
RouteServers:  
RouteTimes:  
$Orig:  
MailFwdBy:  
$AssistMail:  
Auto-submitted:  
DeliveryReport:  
SMTPOriginator:  
$UpdatedBy:  
Categories:  
$Revisions:  
$MsgTrackFlags:  
DeliveredDate:  
DisplayCopyTo_Icon: 
$FolderRef:  
$FolderRefID:  
$FolderRefFlags: 
$Abstract:  


Body:  Abteilung: Nord
Name: Kannix
Vorname: Ich
Personalnummer: 100M7927
Einheit: ZEN
Erreichbarkeit (LoNo): Ichkannix@xxxxx.org
Bemerkungen  (Bei mehreren Teilnehmern bitte alle Teilnehmer hier 
aufführen):
Termin: 22.03.2022 (Di) Nachmittag


Received: 
$MessageID:  
Received:  
Received:  
SendTo: 
From:  
Subject:   
ReplyTo:  
PostedDate:  
$MIMETrack:  
$INetOrig:  
$Created: 
TNEFEvaluated:  
HasSafeStamp:  
RouteServers:  
RouteTimes:  
$Orig:  
MailFwdBy:  
$AssistMail:  
Auto-submitted:  
DeliveryReport:  
SMTPOriginator:  
$UpdatedBy:  
Categories:  
$Revisions:  
$MsgTrackFlags:  
DeliveredDate:  
DisplayCopyTo_Icon: 
$FolderRef:  
$FolderRefID:  
$FolderRefFlags: 
$Abstract:  


Body:  Abteilung: Nord
Name: Kannix
Vorname: Ich
Personalnummer: 100M7927
Einheit: ZEN
Erreichbarkeit (LoNo): Ichkannix@xxxxx.org
Bemerkungen  (Bei mehreren Teilnehmern bitte alle Teilnehmer hier 
aufführen):
Termin: 22.03.2022 (Di) Nachmittag

Alles anzeigen

Ich brauche alles was nach Body: kommt. Alles was darüber ist, kann weg bleiben und soll dann in einer Exceltabelle Platz finden. Name / Vorname / Abtelung / Einhet / Personalnummer / Erreichbarkeit / Termin / Bemerkungen

Vielen Dank schonmal an den "Erlöser"

yard2

Mit einem Makro sollte das kein Problem sein.
Die Mail als Text einfach markieren und in Excel erste Spalte einfügen.
Hier mal eines, kein schönes, geht aber
Schreibt die Daten dann getrennt in Spalte 5 und 6.
Kannst du dann anpassen und erweitern.

Spoiler anzeigen

Code

Sub filtersheet()
Dim i As Integer


i = 1
While i < 1000
    If Cells(i, 1) <> "" Then
        If InStr(1, Cells(i, 1), "Body:", 1) <> 0 Then
            Cells(i, 5) = "Body:"
            Cells(i, 6) = Right(Cells(i, 1), Len(Cells(i, 1)) - 7)
        End If
        If InStr(1, Cells(i, 1), "Name:", 1) <> 0 Then
            Cells(i, 5) = "Name:"
            Cells(i, 6) = Right(Cells(i, 1), Len(Cells(i, 1)) - 6)
        End If
        If InStr(1, Cells(i, 1), "Vorname:", 1) <> 0 Then
            Cells(i, 5) = "Vorname:"
            Cells(i, 6) = Right(Cells(i, 1), Len(Cells(i, 1)) - 9)
        End If
        If InStr(1, Cells(i, 1), "Einheit:", 1) <> 0 Then
            Cells(i, 5) = "Einheit:"
            Cells(i, 6) = Right(Cells(i, 1), Len(Cells(i, 1)) - 9)
        End If
    End If


i = i + 1
Wend


End Sub

Alles anzeigen

edelheizer

Hey, danke. Funktioniert leider nicht ganz, da der gesamte Email in der Excel Tabelle verbleibt und nur die Daten quasi nach "rechts" verschiebt.

yard2

Immer diese Sonderwünsche

Spoiler anzeigen

Code

Sub filtersheet()
Dim i As Integer


i = 1
Do While i < 1000
'Do While (Cells(i, 1) <> "ENDOFLIST") 'add ENDOFLIST in the last row to stop; if you want to use comment i < 1000
    
    If Cells(i, 1) <> "" Then
    
        If InStr(1, Cells(i, 1), "Body:", 1) <> 0 Then
            Cells(i, 5) = "Body:"
            Cells(i, 6) = Right(Cells(i, 1), Len(Cells(i, 1)) - 7)
        End If
    
        If InStr(1, Cells(i, 1), "Name:", 1) <> 0 Then
            Cells(i, 5) = "Name:"
            Cells(i, 6) = Right(Cells(i, 1), Len(Cells(i, 1)) - 6)
        End If
        
        If InStr(1, Cells(i, 1), "Vorname:", 1) <> 0 Then
            Cells(i, 5) = "Vorname:"
            Cells(i, 6) = Right(Cells(i, 1), Len(Cells(i, 1)) - 9)
        End If


        If InStr(1, Cells(i, 1), "Personalnummer:", 1) <> 0 Then
            Cells(i, 5) = "Personalnummer:"
            Cells(i, 6) = Right(Cells(i, 1), Len(Cells(i, 1)) - 16)
        End If
        
        If InStr(1, Cells(i, 1), "Einheit:", 1) <> 0 Then
            Cells(i, 5) = "Einheit:"
            Cells(i, 6) = Right(Cells(i, 1), Len(Cells(i, 1)) - 9)
        End If
        
        If InStr(1, Cells(i, 1), "Erreichbarkeit (LoNo):", 1) <> 0 Then
            Cells(i, 5) = "Erreichbarkeit (LoNo):"
            Cells(i, 6) = Right(Cells(i, 1), Len(Cells(i, 1)) - 23)
        End If
        
        If InStr(1, Cells(i, 1), "Termin:", 1) <> 0 Then
            Cells(i, 5) = "Termin:"
            Cells(i, 6) = Right(Cells(i, 1), Len(Cells(i, 1)) - 8)
        End If


    End If
    
    If Cells(i, 5) <> "" Then
        i = i + 1
    Else
        Rows(i).EntireRow.Delete
    End If
    
    If ((Cells(i, 1) = "") And (Cells(i + 1, 1) = "")) Then
        Exit Do
    End If
Loop


Columns(1).EntireColumn.Delete
Columns(1).EntireColumn.Delete
Columns(1).EntireColumn.Delete
Columns(1).EntireColumn.Delete


End Sub

Alles anzeigen

yard2

Hab oben noch die
Columns(1).EntireColumn.Delete
eingefügt

tojo2503

Hallo,

hatte bei der Arbeit meiner Frau neulich ein identisches Problem. Die haben Anmeldungen per Mail gekriegt und die händisch in eine Datenbank übernommen. Die Datenbank konnte aber Excel importieren. Makros sind so gar nicht meine Stärke, also hab ich python genommen.

Jetzt ziehen sie die Mail aus Outlook in einen Ordner, also als .msg-Datei, und führen ein python Skript aus (ich hab der Einfachheit noch py2exe verwendet).
Das Skript liest mit dem Modul extract_msg die Mail ein und dann kannst du mit xlsxwriter arbeiten. Allerdings hatte ich auch noch einige Spezialfälle mehr, was die Formatierung angeht. Zum Beispiel musste das Geburtsdatum aus dem Format 01.02.2023 für den Import in 3 Spalten aufgeteilt werden (Tag, Monat, Jahr).

Aber du hast glaube ich für die mit dem Makro die bessere Lösung.

Viele Grüße

edelheizer

Zitat von yard2

Hab oben noch die
Columns(1).EntireColumn.Delete
eingefügt

Super , vielen Dank. Das hat soweit geklappt, dass alles entschlackt wird. Ich kann bei meinem EMail Programm den gesamten Ordnerinhalt in eine Textdatei ausgeben lassen. Wäre es evtl möglich, das für ein längeres Texdokument zu machen?

Leider sind die IT geschichten hier sehr strikt, und dem ITler sträubt es quasi beom Wort Python

tojo2503

Zitat von edelheizer

Leider sind die IT geschichten hier sehr strikt, und dem ITler sträubt es quasi beom Wort Python

Aber Makros sind in Ordnung. :o das ist eine spannende Restriktion.
Scheint aber auch genau passend für dich zu sein.

Viel Erfolg

yard2

Zitat von edelheizer

Wäre es evtl möglich, das für ein längeres Texdokument zu machen?

Was meinst du mit länger ?
Wenn um die Anzahl der Row geht einfach den Wert
"Do While i < 1000"
so einstellen wie du es brauchst, statt 1000 kannst du auch 10000 reinschreiben

edelheizer

Ah okay,.. danke. Werde ich morgen auf der Arbeit mal versuchen umzusetzen.

edelheizer

Zitat von tojo2503

Aber Makros sind in Ordnung. :o das ist eine spannende Restriktion. ;-)Scheint aber auch genau passend für dich zu sein.
Viel Erfolg

JA, denke das die sich bei mir dadurch schon viel Arbeit gespart haben

Jetzt mitmachen!