Outlook VBA - Emails ins Excel versenden, beim Body - Signatur ignorieren

  • Outlook

Es gibt 7 Antworten in diesem Thema. Der letzte Beitrag () ist von SZR2D.

    Outlook VBA - Emails ins Excel versenden, beim Body - Signatur ignorieren

    Hallo Zusammen, ich habe ein folgendes Problem. Ich will Email direkt in eine Excel Datei verschicken - soweit so gut. Aber zwei Sachen möchte ich noch verbessern:


    - Als Grundlage damit der Skript startet, muss im Betreff "****" enthalten sein:

    Visual Basic-Quellcode

    1. 'Prüfen, ob die Mail verwendet werden kann
    2. If InStr(olMail.Subject, "****") <> 0 Then


    Der Betreff wird dann in eine Zelle übernommen:

    Visual Basic-Quellcode

    1. wsMaster.Range("c" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = olMail.Subject


    Kann ich irgendwas machen, damit der Betreff ohne die Sterne übernommen wird? Evtl. kann man auch irgendwie die Zellen im Excel formatieren, dass nur der Text angezeigt wird, aber ich habe nichts gefunden...

    - Mein Größeres Problem ist aber, dass der Body mit Signatur mitübernommen wird:

    Visual Basic-Quellcode

    1. wsMaster.Range("d" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = olMail.Body


    In die Zelle soll eben nur der Inhalt der Email übernommen werden, ohne jegliche Signaturen usw. Nur das was in der ersten Zeile steht.



    Visual Basic-Quellcode

    1. Option Explicit
    2. Private WithEvents olItems As Outlook.items
    3. Private Sub Application_Startup()
    4. 'Variablen dimensionieren
    5. Dim olApp As Outlook.Application
    6. Dim olns As Outlook.NameSpace
    7. 'Variablen initialisieren
    8. Set olApp = Outlook.Application
    9. Set olns = olApp.GetNamespace("MAPI")
    10. Set olItems = olns.GetDefaultFolder(olFolderInbox).items
    11. End Sub
    12. Private Sub olitems_itemadd(ByVal items As Object)
    13. 'Variablen dimensionieren
    14. Dim olMail As Outlook.MailItem
    15. 'Prüfen, ob item eine Mail ist
    16. If TypeName(items) = "MailItem" Then
    17. Set olMail = items
    18. 'Prüfen, ob die Mail verwendet werden kann
    19. If InStr(olMail.Subject, "****") <> 0 Then
    20. 'Variablen
    21. Dim xlApp As New Excel.Application
    22. Dim wbMaster As Workbook
    23. Dim wsMaster As Worksheet
    24. 'Excel - Applikation sichtbar machen
    25. xlApp.Visible = False
    26. 'Datei öffnen,
    27. Set wbMaster = xlApp.Workbooks.Open("C:\Users\ge405062\Desktop\LOK_LOGBUCH.xlsm")
    28. Set wsMaster = wbMaster.Worksheets(1)
    29. 'Daten kopieren und einfügen
    30. wsMaster.UnProtect Password:="Lok"
    31. wsMaster.Range("B" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1) = olMail.ReceivedTime
    32. wsMaster.Range("A" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1) = "=WEEKNUM(RC[1])"
    33. wsMaster.Range("c" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = olMail.Subject
    34. wsMaster.Range("d" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = olMail.Body
    35. wsMaster.Range("e" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = olMail.Sender
    36. wsMaster.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    37. , AllowFiltering:=True, Password:="Lok"
    38. 'Dateien und Applikation schließen
    39. wbMaster.Close True
    40. xlApp.Quit
    41. End If
    42. End If
    43. End Sub
    Hallo!

    Einfach den Body in ein Array packen und nur die entsprechende Zeile in die Zelle schreiben. Welchen Zähler die Zeile hat musst Du selber herausfinden. Wenn die Email immer den selben Aufbau hat dürfte das leicht sein. Anbei ein Beispiel für Outlook

    Visual Basic-Quellcode

    1. Sub BodyTextZeile1InExcel()
    2. Dim olEmail As Outlook.MailItem
    3. Dim olApp As Outlook.Application
    4. Dim lngBodyLineCount As Long
    5. Dim vntTempBody As Variant
    6. Select Case True
    7. Case TypeOf Application.ActiveWindow Is Outlook.Inspector
    8. Set olEmail = Application.ActiveInspector.CurrentItem
    9. Case Else
    10. With Application.ActiveExplorer.Selection
    11. If .Count Then Set olEmail = .Item(1)
    12. End With
    13. If olEmail Is Nothing Then Exit Sub
    14. End Select
    15. vntTempBody = Split(olEmail.Body, vbCrLf)
    16. MsgBox vntTempBody(4)
    17. End Sub


    BTW:
    In der ersten Zeile steht i.d.R. die Anrede. Die erste Zeile hat immer den Zähler 0.

    Gruß, René
    Hallo Mumpel, vielen Dank für deine Mühe!
    Da ich ein VBA Laie bin, muss ich leider hinterfragen.. Wo baue ich den Sub am besten mit ein?
    Wenn ich richtig verstehe setze ich deinen Code als "call BodyTextZeile1InExcel" irgendwo in meinen Code ein und deinen Sub in einem separaten Modul?

    Es ist unwahrscheinlich, dass der Zähler immer gleich ist. Es wird auf einem Server ein Logbuch abgelegt und unsere Techniker sollen dann ihre Einträge über Email schicken. Die Einträge sind je nach dem Eingriff unterschiedlich lang
    Am besten packst Du Deine VBA Programmierung in ein Modul und nicht einfach auf ein Tabellenblatt.

    Der Code von Mumpel ist beispielhaft zu sehen.

    Füge mal diesen Code in Zeile 40 ein:

    Visual Basic-Quellcode

    1. Dim vntTempBody As Variant
    2. vntTempBody = Split(olEmail.Body, vbCrLf)
    3. Dim intZeile as Integer
    4. Dim strBody as String
    5. For intZeile =0 to UBound(vntTempBody)
    6. If vntTempBody(intZeile) = "MfG" Then 'oder womit immer die Signatur anfängt
    7. Exit For
    8. End If
    9. strBody= strBody & vntTempBody(intZeile) $ vbNewLine
    10. Next
    11. wsMaster.Range("d" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = strBody
    NB. Es ist doch schön, wenn man lesbare Namen vergibt. Siehe auch [VB.NET] Beispiele für guten und schlechten Code (Stil).

    mumpel schrieb:

    INOPIAE schrieb:

    Am besten packst Du Deine VBA Programmierung in ein Modul und nicht einfach auf ein Tabellenblatt.

    Der Code soll doch in Outlook laufen, wenn ich es richtig verstanden habe.

    Genau, der Code soll ablaufen, wenn die E-Mail ankommt.

    Danke! Das funktioniert jetzt genauso, wie ich es mir wünsche))

    Es ist mir jetzt jedoch eine Kleinigkeit aufgefallen, die den Code nicht perfekt macht... Evtl. ist es auch nicht anderes möglich, aber vielleicht fällt euch was auf.
    Ich hab ein Problem festgestellt, wenn die Excel Datei offen ist, kommt es zu einer Fehlermeldung, dass die Datei von einem anderem Programm benutzt wird.
    Die Datei ist auf dem sharepoint abgelegt und eigentlich dürfte es kein Problem geben, wenn die Datei offen ist. Habe ich da was falsch gemacht?

    Visual Basic-Quellcode

    1. ​Option Explicit
    2. Private WithEvents olItems As Outlook.items
    3. Private Sub Application_Startup()
    4. 'Variablen dimensionieren
    5. Dim olApp As Outlook.Application
    6. Dim olns As Outlook.NameSpace
    7. 'Variablen initialisieren
    8. Set olApp = Outlook.Application
    9. Set olns = olApp.GetNamespace("MAPI")
    10. Set olItems = olns.GetDefaultFolder(olFolderInbox).items
    11. End Sub
    12. Private Sub olitems_itemadd(ByVal items As Object)
    13. 'Variablen dimensionieren
    14. Dim olMail As Outlook.MailItem
    15. 'Prüfen, ob item eine Mail ist
    16. If TypeName(items) = "MailItem" Then
    17. Set olMail = items
    18. 'Prüfen, ob die Mail verwendet werden kann
    19. If InStr(olMail.Subject, "****") <> 0 Then
    20. 'Variablen
    21. Dim xlApp As New Excel.Application
    22. Dim wbMaster As Workbook
    23. Dim wsMaster As Worksheet
    24. 'Excel - Applikation sichtbar machen
    25. xlApp.Visible = False
    26. 'Datei öffnen,
    27. Set wbMaster = xlApp.Workbooks.Open("C:\Users\ge405062\3M\Tier 1 Board LOK - General\LOK_LOGBUCH.xlsm")
    28. Set wsMaster = wbMaster.Worksheets(1)
    29. 'Daten kopieren und einfügen
    30. wsMaster.UnProtect Password:="Lok"
    31. wsMaster.Range("B" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1) = olMail.ReceivedTime
    32. wsMaster.Range("A" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1) = "=WEEKNUM(RC[1])"
    33. wsMaster.Range("C" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = olMail.Subject
    34. Dim vntTempBody As Variant
    35. vntTempBody = Split(olMail.Body, vbCrLf)
    36. Dim intZeile As Integer
    37. Dim strBody As String
    38. For intZeile = 0 To UBound(vntTempBody)
    39. If vntTempBody(intZeile) = "ende" Then 'oder womit immer die Signatur anfängt
    40. Exit For
    41. End If
    42. strBody = strBody & vntTempBody(intZeile) & vbNewLine
    43. Next
    44. wsMaster.Range("d" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = strBody
    45. wsMaster.Range("E" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = olMail.Sender
    46. wsMaster.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    47. , AllowFiltering:=True, Password:="Lok"
    48. 'Dateien und Applikation schließen
    49. wbMaster.Close True
    50. xlApp.Quit
    51. End If
    52. End If
    53. End Sub