Leerzeilen bei Outlook per VBA löschen

frager · 27.02.2008

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

verständlich gemacht ;D.

Freue mich auf eure Ideen.

MfG

frager

Matjes · 27.02.2008

Hallo frager,

machen läßt sich viel

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

Gruß Matjes

frager · 28.02.2008

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

frager · 02.03.2008

hat hier keiner ne idee?

Hoffe dann mal weiter auf eine baldige Problemlösung.

MfG

frager

frager · 05.03.2008

@Matjes: Haste ne Idee?

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

MfG

frager

Matjes · 06.03.2008

Hallo frager,

hab im Augenblick viel um die Ohren ...

Ich melde mich am Wochenende

Gruß Matjes

frager · 07.03.2008

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

Matjes · 09.03.2008

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 &lt;> 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 &amp; vbCrLf &amp; vbCrLf
 Const cDOPPELTE_CRLF = vbCrLf &amp; vbCrLf
 Const cEINFACH_CRLF = vbCrLf &amp; vbCrLf
 Const cLEERZEINFACH_CRLF =   &amp; vbCrLf &amp; vbCrLf

->erstmal alle LeerzeichenCRLF gegen CRLF ersetzen
 pos = InStr(1, sTxt, cLEERZEINFACH_CRLF)
 Do While (pos > 0)
  sTxt = Left(sTxt, pos - 1) &amp; cEINFACH_CRLF &amp; 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) &amp; cDOPPELTE_CRLF &amp; Right(sTxt, Len(sTxt) - pos + 1 - Len(cDREIFACH_CRLF))
  pos = InStr(1, sTxt, cDREIFACH_CRLF)
 Loop
 
End Function

Gruß Matjes

frager · 16.03.2008

Obwohl du wohl männlich bist würde ich dich am liebsten für diesen Code knutschen

.
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

Matjes · 16.03.2008

die lediglich Abstände

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 &lt;> 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 &amp; vbCrLf &amp; vbCrLf
 Const cDOPPELTE_CRLF = vbCrLf &amp; vbCrLf
 Const cEINFACH_CRLF = vbCrLf
 Const cLEERZ_EINFACH_CRLF =   &amp; vbCrLf
 cGESCHUETZTESLEERZ_EINFACH_CRLF = Chr(160) &amp; vbCrLf
 
->erstmal alle LeerzeichenCRLF gegen CRLF ersetzen
->auch geschützte LeerzeichenCRLF gegen CRLF
 pos = InStr(1, sTxt, cLEERZ_EINFACH_CRLF)
 If pos &lt; 1 Then pos = InStr(1, sTxt, cGESCHUETZTESLEERZ_EINFACH_CRLF)
 Do While (pos > 0)
  sTxt = Left(sTxt, pos - 1) &amp; cEINFACH_CRLF &amp; Right(sTxt, Len(sTxt) - pos + 1 - Len(cLEERZ_EINFACH_CRLF))
  pos = InStr(1, sTxt, cLEERZ_EINFACH_CRLF)
  If pos &lt; 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) &amp; cDOPPELTE_CRLF &amp; Right(sTxt, Len(sTxt) - pos + 1 - Len(cDREIFACH_CRLF))
  pos = InStr(1, sTxt, cDREIFACH_CRLF)
 Loop
 
End Function

frager · 17.03.2008

Super, auch das klappt einwandfrei.

Vielen vielen Dank und einen schönen Tag.

MfG

frager

Leerzeilen bei Outlook per VBA löschen

frager

Matjes

frager

frager

frager

Matjes

frager

Matjes

frager

Matjes

frager

Leerzeilen bei Outlook per VBA löschen

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums