Leerzeilen bei Outlook per VBA löschen

Dieses Thema Leerzeilen bei Outlook per VBA löschen im Forum "Microsoft Office Suite" wurde erstellt von frager, 27. Feb. 2008.

Thema: Leerzeilen bei Outlook per VBA löschen Hi, ich habe festgestellt, dass durch das Umwandeln einer Html e-mail in nur text viele unnötige Leerzeilen...

  1. Hi,

    ich habe festgestellt, dass durch das Umwandeln einer Html e-mail in nur text viele unnötige Leerzeilen entstehen. Könnte man ein Makro schreiben, dass es beim Klick auf antworten (Habe bereits für das Makro einen Antwortbutton in der Menüleiste erstellt) überflüssige Leerzeilen wie folgt entfernt:

    Wenn nur eine Leerzeile zwischen 2 Sätzen steht bleibt alles so wie es ist, Bsp.:

    text text text text text text text text
    (Leerzeile)
    text text text text text text text text

    Wenn jedoch zwei, drei oder auch mehr Leerzeilen durch die automatische Umstellung auf nur Text entstehen sollen diese automatisch beim Klick auf meinen Button entfernt werden, sprich:

    aus:

    text text text text text text text text
    (Leerzeile)
    (Leerzeile)
    (Leerzeile)
    (Leerzeile)
    text text text text text text text text

    wird:

    text text text text text text text text
    (Leerzeile)
    text text text text text text text text


    Hoffe ich habe mich Anhand meiner, wie ich finde, gelungenen Aufführung :p verständlich gemacht ;D.

    Freue mich auf eure Ideen.


    MfG

    frager
     
  2. Hallo frager,

    machen läßt sich viel ;)

    Welche Office- und Outlook-Version benutzt du ?
    Ist Word dein mail-Editor ?

    Gruß Matjes :)
     
  3. Hi,

    ich benutze Outlook 2003 standardmäßig und habe soweit nix verändern, sprich Standardeinstellungen. Dementsprechend denke ich nicht, dass word mein e-mail editor ist?! (Kenn mich mit Outllok fast garnicht aus)

    Man hat mir jedoch ein kleines Makro geschrieben, welches ich bereits in meinen Antwortbutton eingefügt habe. Möchte dieses wiederum um die von mir beschriebene Funktion erweitern (also VBA).

    Hier das Makro:

    Sub AnwortMail()
    On Error Resume Next

    'Benötigte Variablen
    Dim myOlSelection As Outlook.Selection
    Dim myOlMailItem As Outlook.MailItem
    Dim NewMail As MailItem
    Set myOlSelection = Application.ActiveExplorer.Selection

    'Erzeugen einer neuen Email als Antwort
    For Each myOlMailItem In myOlSelection

    Set NewMail = myOlMailItem.Reply
    If NewMail.BodyFormat = olFormatHTML Then
    NewMail.BodyFormat = olFormatPlain
    Else
    End If
    NewMail.Display

    Next
    End Sub
     
  4. hat hier keiner ne idee?

    Hoffe dann mal weiter auf eine baldige Problemlösung.


    MfG

    frager
     
  5. @Matjes: Haste ne Idee?

    Würde mich auf deinen/ Eure Beiträge freuen.


    MfG

    frager
     
  6. Hallo frager,

    hab im Augenblick viel um die Ohren ...

    Ich melde mich am Wochenende

    Gruß Matjes :)
     
  7. Hi,

    danke für die Antwort. Werde dann mal gespannt auf deine Lösung warten.

    Hoffe es ist möglich das vorhandene Markro um diese Funktion zu erweitern.


    MfG

    frager
     
  8. Hallo frager,

    ersetze dein Makro durch folgendes:
    Code:
    Option Explicit
    
    Sub AnwortMail()
    On Error Resume Next
    
    'Benötigte Variablen
    Dim myOlSelection As Outlook.Selection
    Dim myOlMailItem As Outlook.MailItem
    Dim NewMail As MailItem
    Set myOlSelection = Application.ActiveExplorer.Selection
    
    'Erzeugen einer neuen Email als Antwort
    For Each myOlMailItem In myOlSelection
    
      Set NewMail = myOlMailItem.Reply
      
     ->Auf jeden Fall nur Text einstellen
      If NewMail.BodyFormat <> olFormatPlain Then
        NewMail.BodyFormat = olFormatPlain
      End If
      
      Dim sTxt As String
      sTxt = NewMail.Body
      Call DreifachLeerZeilenEntfernen(sTxt)
      NewMail.Body = sTxt
      
      NewMail.Display
      
    Next
    End Sub
    
    Private Function DreifachLeerZeilenEntfernen(sTxt As String)
    
     Dim pos As Long
     Dim lLen As Long
     
    ->CR + LF
     Const cDREIFACH_CRLF = vbCrLf & vbCrLf & vbCrLf
     Const cDOPPELTE_CRLF = vbCrLf & vbCrLf
     Const cEINFACH_CRLF = vbCrLf & vbCrLf
     Const cLEERZEINFACH_CRLF =   & vbCrLf & vbCrLf
    
    ->erstmal alle LeerzeichenCRLF gegen CRLF ersetzen
     pos = InStr(1, sTxt, cLEERZEINFACH_CRLF)
     Do While (pos > 0)
      sTxt = Left(sTxt, pos - 1) & cEINFACH_CRLF & Right(sTxt, Len(sTxt) - pos + 1 - Len(cLEERZEINFACH_CRLF))
      pos = InStr(1, sTxt, cLEERZEINFACH_CRLF)
     Loop
    
    ->dreifache gegen doppelte Zeilenwechsel ersetzen
     pos = InStr(1, sTxt, cDREIFACH_CRLF)
     Do While (pos > 0)
      sTxt = Left(sTxt, pos - 1) & cDOPPELTE_CRLF & Right(sTxt, Len(sTxt) - pos + 1 - Len(cDREIFACH_CRLF))
      pos = InStr(1, sTxt, cDREIFACH_CRLF)
     Loop
     
    End Function
    Gruß Matjes :)
     
  9. Obwohl du wohl männlich bist würde ich dich am liebsten für diesen Code knutschen :D.
    Weltklasse!!! mml

    Nur noch eine kleinigkeit :1, hatte nämlich diesen Fall nicht bedacht?

    Gibt es eine Möglichkeit Leerzeilen zu löschen, die lediglich Abstände enthalten?

    Hab nämlich einige E-Mails wie folgt erhalten:

    TEXT
    ->
    ->
    ->
    ->
    ->
    TEXT

    Die Apostrophs habe ich nur gesetzt um die Abstände zu visualisieren.
    Ist es denn möglich auch solche Leerzeilen zu entfernen?

    Dich hoffentlich zum letzten Mal um Hilfe bitten müssend verbleibe ich


    Mit freundlichen Grüßen

    frager
     
  10. sind geschützte Leerzeichen. ;)

    Nun die Version, die auch geschützte Leerzeichen (Chr(160)) wegrasiert.

    Gruß Matjes :)
    Code:
    Option Explicit
    
    Sub AnwortMail()
    On Error Resume Next
    
    'Benötigte Variablen
    Dim myOlSelection As Outlook.Selection
    Dim myOlMailItem As Outlook.MailItem
    Dim NewMail As MailItem
    Set myOlSelection = Application.ActiveExplorer.Selection
    
    'Erzeugen einer neuen Email als Antwort
    For Each myOlMailItem In myOlSelection
    
      Set NewMail = myOlMailItem.Reply
      
     ->Auf jeden Fall nur Text einstellen
      If NewMail.BodyFormat <> olFormatPlain Then
        NewMail.BodyFormat = olFormatPlain
      End If
      
      Dim sTxt As String
      sTxt = NewMail.Body
      Call DreifachLeerZeilenEntfernen(sTxt)
      NewMail.Body = sTxt
      
      NewMail.Display
      
    Next
    End Sub
    
    Private Function DreifachLeerZeilenEntfernen(sTxt As String)
    
     Dim pos As Long, lLen As Long
     Dim cGESCHUETZTESLEERZ_EINFACH_CRLF
     
    ->CR + LF
     Const cDREIFACH_CRLF = vbCrLf & vbCrLf & vbCrLf
     Const cDOPPELTE_CRLF = vbCrLf & vbCrLf
     Const cEINFACH_CRLF = vbCrLf
     Const cLEERZ_EINFACH_CRLF =   & vbCrLf
     cGESCHUETZTESLEERZ_EINFACH_CRLF = Chr(160) & vbCrLf
     
    ->erstmal alle LeerzeichenCRLF gegen CRLF ersetzen
    ->auch geschützte LeerzeichenCRLF gegen CRLF
     pos = InStr(1, sTxt, cLEERZ_EINFACH_CRLF)
     If pos < 1 Then pos = InStr(1, sTxt, cGESCHUETZTESLEERZ_EINFACH_CRLF)
     Do While (pos > 0)
      sTxt = Left(sTxt, pos - 1) & cEINFACH_CRLF & Right(sTxt, Len(sTxt) - pos + 1 - Len(cLEERZ_EINFACH_CRLF))
      pos = InStr(1, sTxt, cLEERZ_EINFACH_CRLF)
      If pos < 1 Then pos = InStr(1, sTxt, cGESCHUETZTESLEERZ_EINFACH_CRLF)
     Loop
    
    ->dreifache gegen doppelte Zeilenwechsel ersetzen
     pos = InStr(1, sTxt, cDREIFACH_CRLF)
     Do While (pos > 0)
      sTxt = Left(sTxt, pos - 1) & cDOPPELTE_CRLF & Right(sTxt, Len(sTxt) - pos + 1 - Len(cDREIFACH_CRLF))
      pos = InStr(1, sTxt, cDREIFACH_CRLF)
     Loop
     
    End Function
     
Die Seite wird geladen...

Leerzeilen bei Outlook per VBA löschen - Ähnliche Themen

Forum Datum
Leerzeilen löschen - Fehler im Code Windows XP Forum 7. Aug. 2006
Leerzeilen löschen mit VBA Windows XP Forum 29. Mai 2005
Makro zur Automatisierung des Ausblendens von Leerzeilen? Microsoft Office Suite 1. Okt. 2004
OUTLOOK - PROFILE ERSTELLEN .... Windows 10 Forum 1. Nov. 2016
Outlook holt keine Mails mehr ab (0x80004005) Microsoft Office Suite 19. Juni 2016