Outlook Makro, das bestimmte Zeilen einer E-Mail druckt

[Dave57]

Momentan schickt unser Ticket System für jedes Ticket eine E-Mail. Diese E-Mail hat immer den gleichen Aufbau und folgenden Inhalt:

Es wurde eine Aufgabe, in deren Zuständigkeit Sie fallen angelegt. 

Aufgabeninformationen: 
------------------------------------ 
Ticketnummer: CCC934931
Projekt: Beispiel
Kontakt: Mustermann
Starttermin: 15.07.2019 
Fällig am: 19.07.2019 
Priorität: 3 
Auslieferung:
Level:
Planaufwand: 8
Kategorie:
Limit:
Angelegt durch:
Bearbeiter der Aufgabe: Mustermann, Musterfrau
Kurzbeschreibung: Testbeschreibung
Aufgabenstellung:

Nun wird nicht jede Zeile benötigt sondern nur folgende:

Ticketnummer:
Fällig am:
Planaufwand:
Bearbeiter der Aufgabe:
Kurzbeschreibung:

Diese 5 Zeilen sollen nun mit Hilfe eines Outlook Makros an einen Etikettendrucker ausgedruckt werden. Wie genau das Druckformat für das Etikett später angepasst werden muss, ist erstmal egal. Es geht nur um den Code denn ich habe leider wirklich überhaupt keine Ahnung von VBA ? 

 

Gibt es jemanden, der hierbei Hilfestellung geben könnte? Das Makro wird in Outlook 2010 benutzt.

Vielen Dank!

[allesweg]

Welches Ticketsystem habt ihr? Da könnte man etwas früher abgreifen...

Ticketsystem - Mailserver - Mailclient - Programmcode - Druckserver

[Dave57]

vor 6 Minuten schrieb allesweg:

Welches Ticketsystem habt ihr? Da könnte man etwas früher abgreifen...

Ticketsystem - Mailserver - Mailclient - Programmcode - Druckserver

Hallo und danke für die schnelle Antwort. Wir haben ein selbst geschriebenes Ticketsystem. Zugriff auf den Code, etc. habe ich aber leider nicht. Deshalb fällt diese Option leider weg. 

Es soll auch nicht automatisch jedes Ticket gedruckt werden. Ein Mitarbeiter soll sich das Ticket bzw. die E-Mail erstmal durchlesen und entscheidet jedes mal, ob es ausgedruckt werden soll oder nicht. 

Bearbeitet 29. Juli 2019 von Dave57

[Dave57]

Ich habe folgenden Quellcode im Internet gefunden. Hier gibt es um fast das selbe, außer dass hier anschließend noch in Excel kopiert wird. Das brauche ich ja nicht, nur hier sieht man schon mal das bestimmte Zeilen markiert werden. Kann jemand basierend auf dem Quellcode helfen?

Die txt's von den Arrays habe ich schon mal so umbenannt wie ich sie brauche (siehe oben). Mir fehlt nur leider das Wissen um hier groß modifizieren zu können.

 

Sub ExtractPrinterAlerts()
    Dim fMails As Folder, mail As MailItem, txtContent As String, arrContent As Variant, objExcel As Object, wb As Object, sheet As Object, rngStart As Object, rngCurrent As Object, fErledigt as Object
    
    'Pfad zur Excel-Datei
    Const EXCELFILE = "c:\PrinterAlerts.xlsx"
    
    'Ordner in Outlook referenzieren
    Set fMails = Application.Session.Stores("user@domain.net").GetRootFolder.Folders("Druckeralerts")
    'Unterordner referenzieren in den die Mails verschoben werden wenn sie bearbeitet wurden
    Set fErledigt = fMails.Folders("erledigt")
    
    
    If fMails.Items.Count > 0 Then
        'Excel Objekt erzeugen
        Set objExcel = CreateObject("Excel.Application")
        objExcel.DisplayAlerts = False
        
        'Excelfile öffnen
        Set wb = objExcel.Workbooks.Open(EXCELFILE)
        
        'Daten kommen in erstes Worksheet
        Set sheet = wb.Worksheets(1)
        
        'Startzelle in Spalte A ermitteln
        Set rngStart = sheet.Cells(sheet.Rows.Count,1).End(-4162).Offset(1, 0)
        Set rngCurrent = rngStart
        
        While fMails.Items.Count > 0
            
            'aktuelle Mail
            Set mail = fMails.Items(1)
            
            'Body extrahieren
            txtContent = mail.Body
            
            ' Zeilen in ein Array schreiben
            arrLines = Split(txtContent, vbNewLine, -1, vbTextCompare)
            
            ' Zeilen den Variablen zuweisen
            txtAufgabenNummer = arrLines(1)
            txtFaelligAm = arrLines(2)
            txtPlanAufwand = arrLines(3)
            txtAngelegtDurch = arrLines(4)
            txtBearbeiter = arrLines(5)
            txtKurzBeschreibung = arrLines(6)
            txtAufgabenstellung = arrLines(7)
            txtCountTotal = Trim(Split(arrLines(8), ":", 2, vbTextCompare)(1))
            txtCountColor = Trim(Split(arrLines(9), ":", 2, vbTextCompare)(1))
            
            'Setze Werte im Sheet
            With rngCurrent
                .Value = txtStatus
                .Offset(0, 1).Value = txtMessage
                .Offset(0, 2).Value = txtTime
                .Offset(0, 3).Value = txtMachine
                .Offset(0, 4).Value = txtSN
                .Offset(0, 5).Value = txtLocation
                .Offset(0, 6).Value = txtIP
                .Offset(0, 7).Value = txtCountTotal
                .Offset(0, 8).Value = txtCountColor
            End With
            'Excel Zeile eins nach unten verschieben
            Set rngCurrent = rngCurrent.Offset(1, 0)
            
            ' Mail in den 'Erledigt' Ordner verschieben
            mail.Move fErledigt
        Wend
        'Workbook speichern
        wb.Save
        'Excel anzeigen
        objExcel.Visible = True
        objExcel.DisplayAlerts = True
    Else
        MsgBox "Keine Mails zum Bearbeiten im Ordner", vbExclamation
    End If
    
    Set objExcel = Nothing
    Set wb = Nothing
    Set sheet = Nothing
    Set mail = Nothing
End Sub

 

[Dave57]

Zum Verständnis habe ich mal ahnungslos die Excel Sachen rausgelöscht, die wahrscheinlich nicht benötigt werden (?). Der Code funktioniert so natürlich nicht... Formatierungsfehler, etc. und die Printfunktion ist dementsprechend auch nicht drin.

Sub ExtractPrinterAlerts()
    Dim fMails As Folder, mail As MailItem, txtContent As String, arrContent As Variant
   
        While fMails.Items.Count > 0
            
            'aktuelle Mail
            Set mail = fMails.Items(1)
            
            'Body extrahieren
            txtContent = mail.Body
            
            ' Zeilen in ein Array schreiben
            arrLines = Split(txtContent, vbNewLine, -1, vbTextCompare)
            
            ' Zeilen den Variablen zuweisen
            txtAufgabenNummer = arrLines(1)
            txtFaelligAm = arrLines(2)
            txtPlanAufwand = arrLines(3)
            txtAngelegtDurch = arrLines(4)
            txtBearbeiter = arrLines(5)
            txtKurzBeschreibung = arrLines(6)
            txtAufgabenstellung = arrLines(7)
            txtCountTotal = Trim(Split(arrLines(8), ":", 2, vbTextCompare)(1))
            txtCountColor = Trim(Split(arrLines(9), ":", 2, vbTextCompare)(1))
            
            'Hier dann irgendwie ausdrucken?'
            
   
End Sub