macros4outlook-commitlog Mailing List for Macros for Outlook

Brought to you by: daniel309, olly98

macros4outlook-commitlog — Mailinglist for svn commits

You can subscribe to this list here.

2009	_Jan	_Feb	_Mar	_Apr	_May	_Jun	_Jul	_Aug	_Sep	_Oct (4)	_Nov	_Dec
2010	_Jan (1)	_Feb	_Mar	_Apr	_May (2)	_Jun	_Jul (2)	_Aug	_Sep (1)	_Oct	_Nov	_Dec
2011	_Jan	_Feb (1)	_Mar (1)	_Apr (37)	_May (4)	_Jun (1)	_Jul (2)	_Aug	_Sep (1)	_Oct (2)	_Nov	_Dec
2012	_Jan (5)	_Feb	_Mar	_Apr	_May	_Jun (2)	_Jul (1)	_Aug	_Sep	_Oct	_Nov	_Dec

Flat | Threaded

1 2 3 > >> (Page 1 of 3)

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[113] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2012-07-03 21:48:20

Revision: 113
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=113&view=rev
Author:   olly98
Date:     2012-07-03 21:48:14 +0000 (Tue, 03 Jul 2012)
Log Message:
-----------
Applied fix by "helper-01" to enable macro usage at 64bit Outlook

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2012-06-22 13:59:52 UTC (rev 112)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2012-07-03 21:48:14 UTC (rev 113)
@@ -111,6 +111,7 @@
 '$Revision$ - not released
 '  * If sender name is encloded in quotes, these quotes are stripped
 '  * Now recognizes LastnameFirstname as sender name format, too.
+'  * Applied fix by "helper-01" to enable macro usage at 64bit Outlook
 
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -263,7 +264,7 @@
 
 
 'For QuoteColorizer
-Public Declare Function WriteRTF _
+Public Declare PtrSafe Function WriteRTF _
         Lib "mapirtf.dll" _
         Alias "writertf" (ByVal ProfileName As String, _
                           ByVal MessageID As String, _
@@ -272,7 +273,7 @@
         As Integer
 
 'For QuoteColorizer
-Public Declare Function ReadRTF _
+Public Declare PtrSafe Function ReadRTF _
         Lib "mapirtf.dll" _
         Alias "readrtf" (ByVal ProfileName As String, _
                          ByVal SrcMsgID As String, _

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[112] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2012-06-22 13:59:58

Revision: 112
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=112&view=rev
Author:   olly98
Date:     2012-06-22 13:59:52 +0000 (Fri, 22 Jun 2012)
Log Message:
-----------
added support for LastnameFirstname format

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2012-06-22 13:40:56 UTC (rev 111)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2012-06-22 13:59:52 UTC (rev 112)
@@ -109,7 +109,8 @@
 '  * support for fixed firstNames for configured email adresses
 '
 '$Revision$ - not released
-'  * If sender name is enclodes in quotes, these quotes are stripped
+'  * If sender name is encloded in quotes, these quotes are stripped
+'  * Now recognizes LastnameFirstname as sender name format, too.
 
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -1045,6 +1046,11 @@
     
 End Function
 
+Private Function IsUpperCaseChar(ByVal c As String) As Boolean
+    IsUpperCaseChar = ((Asc(c) >= 65) And (Asc(c) <= 90))
+End Function
+
+
 'Extracts the name of the sender from the sender's name provided in the E-Mail.
 '
 'In:
@@ -1107,6 +1113,28 @@
             If pos > 0 Then
                 'first name is separated by a dot
                 tmpName = Left(tmpName, pos - 1)
+            Else
+                'name is a single string, without "." or " "
+                'final guess: LastnameFirstname
+                If (IsUpperCaseChar(Left(tmpName, 1))) Then
+                    Dim i As Integer
+                    i = 2
+                    Dim UpperCaseCharCount As Integer
+                    UpperCaseCharCount = 0
+                    Dim LastUpperCaseCharPos As Integer
+                    LastUpperCaseCharPos = 0
+                    Do While (i < Len(tmpName) And (UpperCaseCharCount < 2))
+                        If (IsUpperCaseChar(mid(tmpName, i, 1))) Then
+                            LastUpperCaseCharPos = i
+                            UpperCaseCharCount = UpperCaseCharCount + 1
+                        End If
+                        i = i + 1
+                    Loop
+                    If (UpperCaseCharCount = 1) Then
+                        'LastnameFirstname format found
+                        tmpName = mid(tmpName, LastUpperCaseCharPos)
+                    End If
+                End If
             End If
             firstName = tmpName
         End If

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[111] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2012-06-22 13:41:05

Revision: 111
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=111&view=rev
Author:   olly98
Date:     2012-06-22 13:40:56 +0000 (Fri, 22 Jun 2012)
Log Message:
-----------
If sender name is enclodes in quotes, these quotes are stripped

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2012-01-11 20:43:06 UTC (rev 110)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2012-06-22 13:40:56 UTC (rev 111)
@@ -109,7 +109,7 @@
 '  * support for fixed firstNames for configured email adresses
 '
 '$Revision$ - not released
-'  * no changes yet
+'  * If sender name is enclodes in quotes, these quotes are stripped
 
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -1060,9 +1060,16 @@
     
     Dim tmpName As String
     tmpName = originalName
-    senderName = originalName
     
-    'default: fullname
+    'cleanup quotes: if name is encloded in quotes, just remove them
+    If (Left(tmpName, 1) = """" And Right(tmpName, 1) = """") Then
+        tmpName = mid(tmpName, 2, Len(tmpName) - 2)
+    End If
+    
+    'full senderName is the originalName without quotes
+    senderName = tmpName
+    
+    'default firstName: fullname
     firstName = tmpName
     
     Dim title As String
@@ -1117,13 +1124,13 @@
 
 
 'Extracts the name of the sender from the sender's name provided in the E-Mail.
-'Future work is to extract the first name out of the stored Outlook contacts (if that contact exists)
+'TODO: Future work is to extract the first name out of the stored Outlook contacts (if that contact exists)
 '
 'Notes:
 '  * Names are returned by reference
 Private Sub getNames(ByRef OriginalMail As MailItem, ByRef senderName As String, ByRef firstName As String)
     
-    'Wildcard replaces
+    'Wildcard replacements
     senderName = OriginalMail.SentOnBehalfOfName
     
     If senderName = "" Then

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[110] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2012-01-11 20:43:12

Revision: 110
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=110&view=rev
Author:   olly98
Date:     2012-01-11 20:43:06 +0000 (Wed, 11 Jan 2012)
Log Message:
-----------
re-enabled history for TRUNK version

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2012-01-11 20:42:01 UTC (rev 109)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2012-01-11 20:43:06 UTC (rev 110)
@@ -1,7 +1,7 @@
 Attribute VB_Name = "QuoteFixMacro"
 '$Id$
 
-'QuoteFix Macro 1.5
+'QuoteFix Macro TRUNK
 
 'QuoteFix Macro is part of the macros4outlook project
 'see http://sourceforge.net/projects/macros4outlook/ for more information
@@ -107,6 +107,9 @@
 '  * Letters of first name are also lower cased
 '  * Only the first word of a potential first name is used as first name
 '  * support for fixed firstNames for configured email adresses
+'
+'$Revision$ - not released
+'  * no changes yet
 
 'Ideas were taken from
 '  * Daniele Bochicchio

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[109] quotefixmacro

From: <ol...@us...> - 2012-01-11 20:42:12

Revision: 109
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=109&view=rev
Author:   olly98
Date:     2012-01-11 20:42:01 +0000 (Wed, 11 Jan 2012)
Log Message:
-----------
release of version 1.5

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Added Paths:
-----------
    quotefixmacro/tags/1.5/
    quotefixmacro/tags/1.5/QuoteFixMacro.bas
    quotefixmacro/tags/1.5/exampleFirstNameConfiguration.reg


Property changes on: quotefixmacro/tags/1.5
___________________________________________________________________
Added: bugtraq:number
   + true

Copied: quotefixmacro/tags/1.5/QuoteFixMacro.bas (from rev 107, quotefixmacro/trunk/QuoteFixMacro.bas)
===================================================================
--- quotefixmacro/tags/1.5/QuoteFixMacro.bas	                        (rev 0)
+++ quotefixmacro/tags/1.5/QuoteFixMacro.bas	2012-01-11 20:42:01 UTC (rev 109)
@@ -0,0 +1,1357 @@
+Attribute VB_Name = "QuoteFixMacro"
+'$Id$
+
+'QuoteFix Macro 1.5
+
+'QuoteFix Macro is part of the macros4outlook project
+'see http://sourceforge.net/projects/macros4outlook/ for more information
+
+'The page
+'http://sourceforge.net/apps/mediawiki/macros4outlook/index.php?title=QuoteFix_Macro#Configuration
+'provides information about configuration of QuoteFixMacro
+
+'For more information on Outlook see http://www.microsoft.com/outlook
+'Outlook is (C) by Microsoft
+
+
+'If you like this software, please write a post card to
+'
+'Oliver Kopp
+'Schwabstr. 70a
+'70193 Stuttgart
+'Germany
+'
+'If you don't have money (or don't like the software that much, but
+'appreciate the development), please send an email to
+'mac...@li....
+'
+'For bug reports please go to our sourceforge bugtracker: http://sourceforge.net/projects/macros4outlook/support
+'
+'Thank you :-)
+
+
+'****************************************************************************
+'License:
+'
+'QuoteFix Macro
+'  copyright 2006-2009 Oliver Kopp and Daniel Martin. All rights reserved.
+'  copyright 2010-2012 Oliver Kopp and Lars Monsees. All rights reserved.
+'
+'
+'Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+'
+'   1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+'   2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+'   3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission.
+'
+'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+'****************************************************************************
+
+'Changelog
+'
+'Version 1.0a - 2006-09-14
+' * first public release
+'
+'Version 1.1 - 2006-09-15
+' * Macro %OH introduced
+' * Outlook header contains "> " at the end
+' * If no macros are in the signature, the default behavior of outlook (insert header and quoted text) text is used. (1.0a removed the header)
+'
+'Version 1.2 - 2006-09-25
+' * QuoteFix now also fixes newly introduced first-level-quotes ("> text")
+' * Header matching now matches the English header
+'
+'Version 1.2a - 2006-09-26
+' * quick fix of bug introduced by reformating first-level-quotes
+'   (it was reformated too often)
+'
+'Version 1.2b - 2007-01-24
+' * included on-behalf-of handling written by Per Soderlind (per [at] soderlind [dot] no)
+'
+'Version 1.3 - 2011-04-22
+' * included %C patch 2778722 by Karsten Heimrich
+' * included %SE patch 2807638 by Peter Lindgren
+' * check for beginning of quote is now language independent
+' * added support to strip quotes of level N and greater
+' * more support of alternative name formatting
+'   * added support of reversed name format ("Lastname, Firstname" instead of "Firstname Lastname")
+'   * added support of "LASTNAME firstname" format
+'   * if no firstname is found, then the destination is used
+'     * "firstname.lastname@domain" is supported
+'   * firstName always starts with an uppercase letter
+'   * Added support for "Dr."
+' * added USE_COLORIZER and USE_SOFTWRAP conditional compiling flags.
+'     They enable QuoteColorizerMacro and SoftWrapMacro
+' * splitted code for parsing mailtext from FixMailText() into smaller functions
+' * added support of removing the sender\xB4s signature
+' * bugfix: FinishBlock() would in some cases throw error 5
+' * bugfix: Prevent error 91 when mail is marked as possible phishing mail
+' * Original mail is marked as read
+' * Added CONVERT_TO_PLAIN flag to enable viewing mails as HTML first.
+' * renamed "fromName" to "senderName" in order to reflect real content of the variable
+' * fixed cursor position in the case of absence of "%C", but presence of "%Q"
+'
+'Version 1.4 - 2011-07-04
+'  * Added CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS, which condenses quoted outlook headers
+'    The format of the condensed header is configured at CONDENSED_HEADER_FORMAT
+'  * Added CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER
+'  * Fixed compile time constants to work with Outlook 2007 and 2010
+'  * Added support for custom template configured in the macro (QUOTING_TEMPLATE) - this can be used instead of the signature configuration
+'  * Merged SoftWrap and QuoteColorizerMacro into QuoteFixMacro.bas
+'  * Applied patch 3296731 by Matej Mihelic - Replaced hardcoded call to "MAPI"
+'  * Added LoadConfiguration() so you can store personal settings in the registry. These won\xB4t get lost when updating the macro
+'
+'Version 1.5 - 2012-01-11
+'  * bugfix: When a mail was signed or encrypted with PGP, the reformatting would yield incorrect results
+'  * bugfix: When a sender\xB4s name could not be determined correctly, it would have thrown an error 5
+'  * Letters of first name are also lower cased
+'  * Only the first word of a potential first name is used as first name
+'  * support for fixed firstNames for configured email adresses
+
+'Ideas were taken from
+'  * Daniele Bochicchio
+'    Button integration and sample code - http://lab.aspitalia.com/35/Outlook-2007-2003-Reply-With-Quoting-Macro.aspx
+'  * Dominik Jain
+'    Outlook Quotefix. An excellent program working up to Outlook 2003: http://home.in.tum.de/~jain/software/outlook-quotefix/
+
+'Precondition:
+' * The received mail has to contain the right quotes. Wrong original quotes can not always be fixed
+'   > > > w1
+'   > >
+'   > > w2
+'   > >
+'   > > > w3
+'   won't be fixed to w1 w2 w3. How can it be known, that w2 belongs to w1 and w3?
+
+Option Explicit
+
+
+'----- DEFAULT CONFIGURATION ------------------------------------------------------------------------------------------
+'The configuration is now stored in the registry
+'Below, the DEFAULT values are provided
+'
+'The macro NEVER stores entries in the registry by itself
+'
+'You can store the default configuration in the registry by executing
+'  StoreDefaultConfiguration()
+'or by writing a routing executing commands similar to the following:
+'   Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONVERT_TO_PLAIN", "true")
+'Finally, or by manually creating entries in this registry hive:
+'    HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro
+Private Const APPNAME As String = "QuoteFixMacro"
+Private Const REG_GROUP_CONFIG As String = "Config"
+Private Const REG_GROUP_FIRSTNAMES As String = "Firstnames" 'stores replacements for firstnames
+
+
+'--------------------------------------------------------
+'*** Feature QuoteColorizer ***
+'--------------------------------------------------------
+Private Const DEFAULT_USE_COLORIZER As Boolean = False
+'If you enable it, you need MAPIRTF.DLL in C:\Windows\System32
+'Does NOT work at Windows 7/64bit Outlook 2010/32bit
+'
+'Please enable convert RTF-to-Text at sending. Otherwise, the recipients will always receive HTML E-Mails
+
+'How many different colors should be used for colorizing the quotes?
+Private Const DEFAULT_NUM_RTF_COLORS As Integer = 4
+
+
+'--------------------------------------------------------
+'*** Feature SoftWrap ***
+'--------------------------------------------------------
+'Enable SoftWrap
+'resize window so that the text editor wraps the text automatically
+'after N charaters. Outlook wraps text automatically after sending it,
+'but doesn't display the wrap when editing
+'you can edit the auto wrap setting at "Tools / Options / Email Format / Internet Format"
+Private Const DEFAULT_USE_SOFTWRAP As Boolean = False
+
+'put as much characters as set in Outlook at "Tools / Options / Email Format / Internet Format"
+Private Const DEFAULT_SEVENTY_SIX_CHARS As String = "123456789x123456789x123456789x123456789x123456789x123456789x123456789x123456"
+
+'This constant has to be adapted to fit your needs (incoprating the used font, display size, ...)
+Private Const DEFAULT_PIXEL_PER_CHARACTER As Double = 8.61842105263158
+
+
+'--------------------------------------------------------
+'*** Configuration constants ***
+'--------------------------------------------------------
+'If <> -1, strip quotes with level > INCLUDE_QUOTES_TO_LEVEL
+Private Const DEFAULT_INCLUDE_QUOTES_TO_LEVEL As Integer = -1
+
+'At which column should the text be wrapped?
+Private Const DEFAULT_LINE_WRAP_AFTER As Integer = 75
+
+Private Const DEFAULT_DATE_FORMAT As String = "yyyy-mm-dd"
+'alternative date format
+'Private Const DEFAULT_DATE_FORMAT As String = "ddd, d MMM yyyy at HH:mm:ss"
+
+'Strip the sender\xB4s signature?
+Private Const DEFAULT_STRIP_SIGNATURE As Boolean = True
+
+'Automatically convert HTML/RTF-Mails to plain text?
+Private Const DEFAULT_CONVERT_TO_PLAIN As Boolean = False
+
+'Enable QUOTING_TEMPLATE
+Private Const DEFAULT_USE_QUOTING_TEMPLATE As Boolean = False
+
+'If the constant USE_QUOTING_TEMPLATE is set, this template is used instead of the signature
+Private Const DEFAULT_QUOTING_TEMPLATE As String = _
+"%SN wrote on %D:" & vbCr & _
+"%Q"
+
+
+'--------------------------------------------------------
+'*** Configuration of condensing ***
+'--------------------------------------------------------
+
+'Condense embedded quoted Outlook headers?
+Private Const DEFAULT_CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS As Boolean = True
+
+'Should the first header also be condensed?
+'In case you use a custom header, (e.g., "You wrote on %D:", this should be set to false)
+Private Const DEFAULT_CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER As Boolean = False
+
+'Format of condensed header
+Private Const DEFAULT_CONDENSED_HEADER_FORMAT As String = "%SN wrote on %D:"
+
+'----- END OF DEFAULT CONFIGURATION -----------------------------------------------------------------------------------
+
+
+Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE As String = "-----"
+'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Urspr\xFCngliche Nachricht-----"
+'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Original Message-----"
+Private Const OUTLOOK_ORIGINALMESSAGE   As String = "> " & OUTLOOK_PLAIN_ORIGINALMESSAGE
+Private Const PGP_MARKER                As String = "-----BEGIN PGP"
+Private Const OUTLOOK_HEADERFINISH      As String = "> "
+Private Const SIGNATURE_SEPARATOR       As String = "> --"
+
+Private Const PATTERN_QUOTED_TEXT       As String = "%Q"
+Private Const PATTERN_CURSOR_POSITION   As String = "%C"
+Private Const PATTERN_SENDER_NAME       As String = "%SN"
+Private Const PATTERN_SENDER_EMAIL      As String = "%SE"
+Private Const PATTERN_FIRST_NAME        As String = "%FN"
+Private Const PATTERN_SENT_DATE         As String = "%D"
+Private Const PATTERN_OUTLOOK_HEADER    As String = "%OH"
+
+
+'Variables storing the configuration
+'They are set in LoadConfiguration()
+Private USE_COLORIZER As Boolean
+Private NUM_RTF_COLORS As Integer
+Private USE_SOFTWRAP As Boolean
+Private SEVENTY_SIX_CHARS As String
+Private PIXEL_PER_CHARACTER As Double
+Private INCLUDE_QUOTES_TO_LEVEL As Integer
+Private LINE_WRAP_AFTER As Integer
+Private DATE_FORMAT As String
+Private STRIP_SIGNATURE As Boolean
+Private CONVERT_TO_PLAIN As Boolean
+Private USE_QUOTING_TEMPLATE As Boolean
+Private QUOTING_TEMPLATE As String
+Private CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS As Boolean
+Private CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER As Boolean
+Private CONDENSED_HEADER_FORMAT As String
+
+'These are fetched from the registry (LoadConfiguration), but not saved by StoreDefaultConfiguration
+Private FIRSTNAME_REPLACEMENT__EMAIL() As String
+Private FIRSTNAME_REPLACEMENT__FIRSTNAME() As String
+
+
+'For QuoteColorizer
+Public Declare Function WriteRTF _
+        Lib "mapirtf.dll" _
+        Alias "writertf" (ByVal ProfileName As String, _
+                          ByVal MessageID As String, _
+                          ByVal StoreID As String, _
+                          ByVal cText As String) _
+        As Integer
+
+'For QuoteColorizer
+Public Declare Function ReadRTF _
+        Lib "mapirtf.dll" _
+        Alias "readrtf" (ByVal ProfileName As String, _
+                         ByVal SrcMsgID As String, _
+                         ByVal SrcStoreID As String, _
+                         ByRef MsgRTF As String) _
+        As Integer
+
+
+Private Enum ReplyType
+    TypeReply = 1
+    TypeReplyAll = 2
+    TypeForward = 3
+End Enum
+
+Public Type NestingType
+    'the level of the current quote plus
+    level As Integer
+    
+    'the amount of spaces until the next word
+    'needed as outlook sometimes inserts more than one space to separate the quoteprefix and the actual quote
+    'we use that information to fix the quote
+    additionalSpacesCount As Integer
+    
+    'total = level + additionalSpacesCount + 1
+    total As Integer
+End Type
+
+'Global Variables to make code more readable (-> parameter passing gets easier)
+Private result As String
+Private unformatedBlock As String
+Private curBlock As String
+Private curBlockNeedsToBeReFormated As Boolean
+Private curPrefix As String
+Private lastLineWasParagraph As Boolean
+Private lastNesting As NestingType
+
+'these are the macros called by the custom buttons
+Sub FixedReply()
+    Dim m As Object
+    Set m = GetCurrentItem()
+
+    Call FixMailText(m, TypeReply)
+End Sub
+
+
+Sub FixedReplyAll()
+    Dim m As Object
+    Set m = GetCurrentItem()
+
+    Call FixMailText(m, TypeReplyAll)
+End Sub
+
+
+Sub FixedForward()
+    Dim m As Object
+    Set m = GetCurrentItem()
+
+    Call FixMailText(m, TypeForward)
+End Sub
+
+
+
+
+
+Function CalcNesting(line As String) As NestingType 'changed to default scope
+    Dim lastQuoteSignPos As Integer
+    Dim i As Integer
+    Dim count As Integer
+    Dim curChar As String
+    Dim res As NestingType
+  
+    count = 0
+    i = 1
+  
+    Do While i <= Len(line)
+        curChar = mid(line, i, 1)
+        If curChar = ">" Then
+            count = count + 1
+            lastQuoteSignPos = i
+        ElseIf curChar <> " " Then
+            'Char is neither ">" nor " " - Quote intro ended
+            'leave function
+            Exit Do
+        End If
+        i = i + 1
+    Loop
+    
+    res.level = count
+  
+    If i <= Len(line) Then
+        'i contains the pos of the first character
+        
+        'if there is no space i = lastQuoteSignPos + 1
+        'One space is normal, the others are nesting
+        '  It could be, that there is no space
+        
+        res.additionalSpacesCount = i - lastQuoteSignPos - 2
+        If res.additionalSpacesCount < 0 Then
+            res.additionalSpacesCount = 0
+        End If
+    Else
+        res.additionalSpacesCount = 0
+    End If
+    
+    res.total = res.level + res.additionalSpacesCount + 1 '+1 = trailing space
+    
+    CalcNesting = res
+End Function
+
+'Stores the default values in the system registry
+Public Sub StoreDefaultConfiguration()
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "USE_COLORIZER", DEFAULT_USE_COLORIZER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "NUM_RTF_COLORS", DEFAULT_NUM_RTF_COLORS)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "USE_SOFTWRAP", DEFAULT_USE_SOFTWRAP)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "SEVENTY_SIX_CHARS", DEFAULT_SEVENTY_SIX_CHARS)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "PIXEL_PER_CHARACTER", DEFAULT_PIXEL_PER_CHARACTER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "INCLUDE_QUOTES_TO_LEVEL", DEFAULT_INCLUDE_QUOTES_TO_LEVEL)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "LINE_WRAP_AFTER", DEFAULT_LINE_WRAP_AFTER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "DATE_FORMAT", DEFAULT_DATE_FORMAT)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "STRIP_SIGNATURE", DEFAULT_STRIP_SIGNATURE)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONVERT_TO_PLAIN", DEFAULT_CONVERT_TO_PLAIN)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "USE_QUOTING_TEMPLATE", DEFAULT_USE_QUOTING_TEMPLATE)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "QUOTING_TEMPLATE", DEFAULT_QUOTING_TEMPLATE)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS", DEFAULT_CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER", DEFAULT_CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSED_HEADER_FORMAT", DEFAULT_CONDENSED_HEADER_FORMAT)
+End Sub
+
+'Loads the personal settings from the registry.
+Private Sub LoadConfiguration()
+    USE_COLORIZER = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_COLORIZER", DEFAULT_USE_COLORIZER))
+    NUM_RTF_COLORS = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "NUM_RTF_COLORS", DEFAULT_NUM_RTF_COLORS))
+    USE_SOFTWRAP = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_SOFTWRAP", DEFAULT_USE_SOFTWRAP))
+    SEVENTY_SIX_CHARS = GetSetting(APPNAME, REG_GROUP_CONFIG, "SEVENTY_SIX_CHARS", DEFAULT_SEVENTY_SIX_CHARS)
+    PIXEL_PER_CHARACTER = CDbl(GetSetting(APPNAME, REG_GROUP_CONFIG, "PIXEL_PER_CHARACTER", DEFAULT_PIXEL_PER_CHARACTER))
+    INCLUDE_QUOTES_TO_LEVEL = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "INCLUDE_QUOTES_TO_LEVEL", DEFAULT_INCLUDE_QUOTES_TO_LEVEL))
+    LINE_WRAP_AFTER = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "LINE_WRAP_AFTER", DEFAULT_LINE_WRAP_AFTER))
+    DATE_FORMAT = GetSetting(APPNAME, REG_GROUP_CONFIG, "DATE_FORMAT", DEFAULT_DATE_FORMAT)
+    STRIP_SIGNATURE = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "STRIP_SIGNATURE", DEFAULT_STRIP_SIGNATURE))
+    CONVERT_TO_PLAIN = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONVERT_TO_PLAIN", DEFAULT_CONVERT_TO_PLAIN))
+    USE_QUOTING_TEMPLATE = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_QUOTING_TEMPLATE", DEFAULT_USE_QUOTING_TEMPLATE))
+    QUOTING_TEMPLATE = GetSetting(APPNAME, REG_GROUP_CONFIG, "QUOTING_TEMPLATE", DEFAULT_QUOTING_TEMPLATE)
+    CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS", DEFAULT_CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS))
+    CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER", DEFAULT_CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER))
+    CONDENSED_HEADER_FORMAT = GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSED_HEADER_FORMAT", DEFAULT_CONDENSED_HEADER_FORMAT)
+    
+    Dim count As Variant
+    count = CDbl(GetSetting(APPNAME, REG_GROUP_FIRSTNAMES, "Count", 0))
+    ReDim FIRSTNAME_REPLACEMENT__EMAIL(count)
+    ReDim FIRSTNAME_REPLACEMENT__FIRSTNAME(count)
+    Dim i As Integer
+    For i = 1 To count
+        Dim group As String
+        group = REG_GROUP_FIRSTNAMES & "\" & i
+        FIRSTNAME_REPLACEMENT__EMAIL(i) = GetSetting(APPNAME, group, "email", vbNullString)
+        FIRSTNAME_REPLACEMENT__FIRSTNAME(i) = GetSetting(APPNAME, group, "firstName", vbNullString)
+    Next i
+End Sub
+
+'Description:
+'   Strips away ">" and " " at the beginning to have the plain text
+Private Function StripLine(line As String) As String
+    Dim res As String
+    res = line
+    
+    Do While (Len(res) > 0) And (InStr("> ", Left(res, 1)) <> 0)
+        'First character is a space or a quote
+        res = mid(res, 2)
+    Loop
+    
+    'Remove the spaces at the end of res
+    res = Trim(res)
+    
+    StripLine = res
+End Function
+
+Private Function CalcPrefix(ByRef nesting As NestingType) As String
+    Dim res As String
+    
+    res = String(nesting.level, ">")
+    res = res & String(nesting.additionalSpacesCount, " ")
+    
+    CalcPrefix = res & " "
+End Function
+
+'Description:
+'   Adds the current line to unfomatedBlock and to curBlock
+Private Sub AppendCurLine(ByRef curLine As String)
+    If unformatedBlock = "" Then
+        'unformatedBlock has to be used here, because it might be the case that the first
+        '  line is "". Therefore curBlock remains "", whereas unformatedBlock gets <> ""
+        
+        If curLine = "" Then Exit Sub
+        
+        curBlock = curLine
+        unformatedBlock = curPrefix & curLine & vbCrLf
+    Else
+        curBlock = curBlock & IIf(curBlock = "", "", " ") & curLine
+        unformatedBlock = unformatedBlock & curPrefix & curLine & vbCrLf
+    End If
+End Sub
+
+Private Sub HandleParagraph(ByRef prefix As String)
+    If Not lastLineWasParagraph Then
+        FinishBlock lastNesting
+        lastLineWasParagraph = True
+    Else
+        'lastline was already a paragraph. No further action required
+    End If
+    
+    'Add a new line in all cases...
+    result = result & prefix & vbCrLf
+End Sub
+
+'Description:
+'   Finishes the current Block
+'
+'   Also resets
+'       curBlockNeedsToBeReFormated
+'       curBlock
+'       unformatedBlock
+Private Sub FinishBlock(ByRef nesting As NestingType)
+    If Not curBlockNeedsToBeReFormated Then
+        result = result & unformatedBlock
+    Else
+        'reformat curBlock and append it
+        Dim prefix As String
+        Dim curLine As String
+        Dim maxLength As Integer
+        Dim i As Integer
+    
+        prefix = CalcPrefix(nesting)
+    
+        maxLength = LINE_WRAP_AFTER - nesting.total
+    
+        Do While Len(curBlock) > maxLength
+            'go through block from maxLength to beginning to find a space
+            i = maxLength
+            If i > 0 Then
+                Do While (mid(curBlock, i, 1) <> " ")
+                    i = i - 1
+                    If i = 0 Then Exit Do
+                Loop
+            End If
+    
+            If i = 0 Then
+                'No space found -> use the full line
+                curLine = Left(curBlock, maxLength)
+                curBlock = mid(curBlock, maxLength + 1)
+            Else
+                curLine = Left(curBlock, i - 1)
+                curBlock = mid(curBlock, i + 1)
+            End If
+    
+            result = result & prefix & curLine & vbCrLf
+        Loop
+    
+        If Len(curBlock) > 0 Then
+            result = result & prefix & curBlock & vbCrLf
+        End If
+    End If
+    
+    'Resetting
+    curBlockNeedsToBeReFormated = False
+    curBlock = ""
+    unformatedBlock = ""
+    'lastLineWasParagraph = False
+End Sub
+
+'Reformat text to correct broken wrap inserted by Outlook.
+'Needs to be public so the test cases can run this function.
+Public Function ReFormatText(text As String) As String
+    Dim curLine As String
+    Dim rows() As String
+    Dim lastPrefix As String
+    Dim i As Long
+    Dim curNesting As NestingType
+    Dim nextNesting As NestingType
+
+    'Reset (partially global) variables
+    result = ""
+    curBlock = ""
+    unformatedBlock = ""
+    curNesting.level = 0
+    lastNesting.level = 0
+    curBlockNeedsToBeReFormated = False
+    
+    rows = Split(text, vbCrLf)
+    
+    For i = LBound(rows) To UBound(rows)
+        curLine = StripLine(rows(i))
+        lastNesting = curNesting
+        curNesting = CalcNesting(rows(i))
+        
+        If curNesting.total <> lastNesting.total Then
+            lastPrefix = curPrefix
+            curPrefix = CalcPrefix(curNesting)
+        End If
+        
+        If curNesting.total = lastNesting.total Then
+            'Quote continues
+            If curLine = "" Then
+                'new paragraph has started
+                HandleParagraph curPrefix
+            Else
+                AppendCurLine curLine
+                lastLineWasParagraph = False
+            
+                If (curNesting.level = 1) And (i < UBound(rows)) Then
+                    'check if the next line contains a wrong break
+                    nextNesting = CalcNesting(rows(i + 1))
+                    If (CountOccurencesOfStringInString(curLine, " ") = 0) And (curNesting.total = nextNesting.total) _
+                        And (Len(rows(i - 1)) > LINE_WRAP_AFTER - Len(curLine) - 10) Then '10 is only a rough heuristics... - should be improved
+                        'Yes, it is a wrong Wrap (same recognition as below)
+                        curBlockNeedsToBeReFormated = True
+                    End If
+                End If
+            End If
+        
+        ElseIf curNesting.total < lastNesting.total Then 'curNesting.level = lastNesting.level - 1 doesn't work, because ">>", ">>>", ... are also killed by Office
+            lastLineWasParagraph = False
+            
+            'Quote is indented less. Maybe it's a wrong line wrap of outlook?
+            
+            If (i < UBound(rows)) Then
+                nextNesting = CalcNesting(rows(i + 1))
+                If nextNesting.total = lastNesting.total Then
+                    'Yeah. Wrong line wrap found
+                    
+                    If curLine = "" Then
+                        'The linebreak has to be interpreted as paragraph
+                        'new Paragraph has started. No joining of quotes is necessary
+                        HandleParagraph lastPrefix
+                    Else
+                        curBlockNeedsToBeReFormated = True
+                    
+                        'nesting and prefix have to be adjusted
+                        curNesting = lastNesting
+                        curPrefix = lastPrefix
+                    
+                        AppendCurLine curLine
+                    End If
+                Else
+                    'No wrong line wrap found. Last block is finished
+                    FinishBlock lastNesting
+                    
+                    If curLine = "" Then
+                        If curNesting.level <> lastNesting.level Then
+                            lastLineWasParagraph = True
+                            HandleParagraph curPrefix
+                        End If
+                    End If
+                    
+                    'next block starts with curLine
+                    AppendCurLine curLine
+                End If
+            Else
+                'Quote is the last one - just use it
+                AppendCurLine curLine
+            End If
+        
+        Else
+            'curNesting.total > lastNesting.total
+            
+            lastLineWasParagraph = False
+            
+            'it's nested one level deeper. Current block is finished
+            FinishBlock lastNesting
+        
+            If curLine = "" Then
+                If curNesting.level <> lastNesting.level Then
+                    lastLineWasParagraph = True
+                    HandleParagraph curPrefix
+                End If
+            End If
+            
+            If CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS Then
+                If Left(curLine, Len(OUTLOOK_PLAIN_ORIGINALMESSAGE)) = OUTLOOK_PLAIN_ORIGINALMESSAGE _
+                And Not Left(curLine, Len(PGP_MARKER)) = PGP_MARKER _
+                Then
+                    'We found a header
+                    
+                    Dim posColon As Integer
+                    
+                    'Name and Email
+                    i = i + 1
+                    Dim sName As String
+                    Dim sEmail As String
+                    curLine = StripLine(rows(i))
+                    posColon = InStr(curLine, ":")
+                    Dim posLeftBracket As String
+                    Dim posRightBracket As Integer
+                    posLeftBracket = InStr(curLine, "[") '[ is the indication of the beginning of the E-Mail-Adress
+                    posRightBracket = InStr(curLine, "]")
+                    If (posLeftBracket) > 0 Then
+                        Dim lengthName As Integer
+                        lengthName = posLeftBracket - posColon - 3
+                        If lengthName > 0 Then
+                            sName = mid(curLine, posColon + 2, lengthName)
+                        Else
+                            Debug.Print "Couldn\xB4t get name. Is the header formatted correctly?"
+                        End If
+                        
+                        If posRightBracket = 0 Then
+                            sEmail = mid(curLine, posLeftBracket + 8) '8 = Len("mailto: ")
+                        Else
+                            sEmail = mid(curLine, posLeftBracket + 8, posRightBracket - posLeftBracket - 8) '8 = Len("mailto: ")
+                        End If
+                    Else
+                        sName = mid(curLine, posColon + 2)
+                        sEmail = ""
+                    End If
+                    
+                    i = i + 1
+                    curLine = StripLine(rows(i))
+                    If InStr(curLine, ":") = 0 Then
+                        'There is a wrap in the email-Adress
+                        posRightBracket = InStr(curLine, "]")
+                        If posRightBracket > 0 Then
+                            sEmail = sEmail + Left(curLine, posRightBracket - 1)
+                        Else
+                            'something wrent wrong, do nothing
+                        End If
+                        'go to next line
+                        i = i + 1
+                        curLine = StripLine(rows(i))
+                    End If
+                    
+                    'Date
+                    'We assume that there is always a weekday present before the date
+                    Dim sDate As String
+                    sDate = StripLine(rows(i))
+                    'posColon = InStr(sDate, ":")
+                    'sDate = mid(sDate, posColon + 2)
+                    Dim posFirstComma As Integer
+                    posFirstComma = InStr(sDate, ",")
+                    sDate = mid(sDate, posFirstComma + 2)
+                    Dim dDate As Date
+                    If IsDate(sDate) Then
+                        dDate = DateValue(sDate)
+                        'there is no function "IsTime", therefore try with brute force
+                        dDate = dDate + TimeValue(sDate)
+                    End If
+                    If dDate <> CDate("00:00:00") Then
+                        sDate = Format(dDate, DATE_FORMAT)
+                    Else
+                        'leave sDate as is -> date is output as found in email
+                    End If
+                    
+                    i = i + 3 'skip next three lines (To, [possibly CC], Subject, empty line)
+                    'if CC exists, then i points to the empty line
+                    'if CC does not exist, then i points to the first non-empty line
+                    
+                    'Strip empty lines
+                    Do
+                        i = i + 1
+                        curLine = StripLine(rows(i))
+                    Loop Until (curLine <> "") Or (i = UBound(rows))
+                    i = i - 1 'i now points to the last empty line
+                    
+                    Dim condensedHeader As String
+                    condensedHeader = CONDENSED_HEADER_FORMAT
+                    condensedHeader = Replace(condensedHeader, PATTERN_SENDER_NAME, sName)
+                    condensedHeader = Replace(condensedHeader, PATTERN_SENT_DATE, sDate)
+                    condensedHeader = Replace(condensedHeader, PATTERN_SENDER_EMAIL, sEmail)
+                    
+                    Dim prefix As String
+                    'the prefix for the result has to be one level shorter as it is the quoted text from the sender
+                    If (curNesting.level = 1) Then
+                        prefix = ""
+                    Else
+                        prefix = mid(curPrefix, 2)
+                    End If
+                    
+                    result = result & prefix & condensedHeader & vbCrLf
+                Else
+                    'fall back to default behavior
+                    'next block starts with curLine
+                    AppendCurLine curLine
+                End If
+            Else
+                'next block starts with curLine
+                AppendCurLine curLine
+            End If
+        End If
+    Next i
+    
+    'Finish current Block
+    FinishBlock curNesting
+    
+    'strip last (unnecessary) line feeds and spaces
+    Do While ((Len(result) > 0) And (InStr(vbCr & vbLf & " ", Right(result, 1)) <> 0))
+        result = Left(result, Len(result) - 1)
+    Loop
+    
+    ReFormatText = result
+End Function
+
+
+Private Sub FixMailText(SelectedObject As Object, MailMode As ReplyType)
+    Dim TempObj As Object
+    
+    
+    Call LoadConfiguration
+   
+    
+    'we only understand mail items, no PostItems, NoteItems, ...
+    If Not (TypeName(SelectedObject) = "MailItem") Then
+        On Error GoTo catch:   'try, catch replacement
+        Dim HadError As Boolean
+        HadError = True
+                          
+        Select Case MailMode
+            Case TypeReply:
+                Set TempObj = SelectedObject.Reply
+                TempObj.Display
+                HadError = False
+                Exit Sub
+            Case TypeReplyAll:
+                Set TempObj = SelectedObject.ReplyAll
+                TempObj.Display
+                HadError = False
+                Exit Sub
+            Case TypeForward:
+                Set TempObj = SelectedObject.Forward
+                TempObj.Display
+                HadError = False
+                Exit Sub
+        End Select
+        
+catch:
+        On Error GoTo 0  'deactivate errorhandling
+        
+        If (HadError = True) Then
+            'reply / replyall / forward caused error
+            ' -->  just display it
+            SelectedObject.Display
+            Exit Sub
+        End If
+    End If
+
+    Dim OriginalMail As MailItem
+    Set OriginalMail = SelectedObject  'cast!!!
+    
+    
+    'mails that have not been sent can\xB4t be replied to (draft mails)
+    If Not OriginalMail.Sent Then
+        MsgBox "This mail seems to be a draft, so it cannot be replied to.", vbExclamation
+        Exit Sub
+    End If
+    
+    'we don\xB4t understand HTML mails!!!
+    If Not (OriginalMail.BodyFormat = olFormatPlain) Then
+        If CONVERT_TO_PLAIN Then
+            'Unfortunately, it\xB4s only possible to convert the original mail as there is
+            'no easy way to create a clone. Therefore, you cannot go back to the original format!
+            'If you e.g. would decide that you need to forward the mail in HTML format,
+            'this will not be possible anymore.
+            SelectedObject.BodyFormat = olFormatPlain
+        Else
+            Dim ReplyObj As MailItem
+            
+            Select Case MailMode
+                Case TypeReply:
+                    Set ReplyObj = OriginalMail.Reply
+                Case TypeReplyAll:
+                    Set ReplyObj = OriginalMail.ReplyAll
+                Case TypeForward:
+                    Set ReplyObj = OriginalMail.Forward
+            End Select
+            
+            ReplyObj.Display
+            Exit Sub
+        End If
+    End If
+    
+    'create reply --> outlook style!
+    Dim NewMail As MailItem
+    Select Case MailMode
+        Case TypeReply:
+            Set NewMail = OriginalMail.Reply
+        Case TypeReplyAll:
+            Set NewMail = OriginalMail.ReplyAll
+        Case TypeForward:
+            Set NewMail = OriginalMail.Forward
+    End Select
+    
+    'if the mail is marked as a possible phishing mail, a warning will be shown and
+    'the reply methods will return null (forward method is ok)
+    If NewMail Is Nothing Then Exit Sub
+    
+    'put the whole mail as composed by Outlook into an array
+    Dim BodyLines() As String
+    BodyLines = Split(NewMail.Body, vbCrLf)
+    
+    'lineCounter is used to provide information about how many lines we already parsed.
+    'This variable is always passed to the various parser functions by reference to get
+    'back the new value.
+    Dim lineCounter As Long
+
+    ' A new mail starts with signature -if- set, try to parse until we find the the
+    ' original message separator - might loop until the end of the whole message since
+    ' this depends on the International Option settings (english), even worse it might
+    ' find some separator in-between and mess up the whole reply, so check the nesting too.
+    Dim MySignature As String
+    MySignature = getSignature(BodyLines, lineCounter)
+    ' lineCounter now indicates the line after the signature
+   
+    If USE_QUOTING_TEMPLATE Then
+        'Override MySignature in case the QUOTING_TEMPLATE should be used
+        MySignature = QUOTING_TEMPLATE
+    End If
+
+    Dim senderName As String
+    Dim firstName As String
+    Call getNames(OriginalMail, senderName, firstName)
+    
+    If (UBound(FIRSTNAME_REPLACEMENT__EMAIL) > 0) Or (InStr(MySignature, PATTERN_SENDER_EMAIL) <> 0) Then
+        Dim senderEmail As String
+        senderEmail = getSenderEmailAdress(OriginalMail)
+        MySignature = Replace(MySignature, PATTERN_SENDER_EMAIL, senderEmail)
+    End If
+    
+    If (UBound(FIRSTNAME_REPLACEMENT__EMAIL) > 0) Then
+        'replace firstName by email stored in registry
+        Dim rEmail As Variant
+        Dim curIndex As Integer
+        For curIndex = 1 To UBound(FIRSTNAME_REPLACEMENT__EMAIL)
+            rEmail = FIRSTNAME_REPLACEMENT__EMAIL(curIndex)
+            If (StrComp(LCase(senderEmail), LCase(rEmail)) = 0) Then
+                firstName = FIRSTNAME_REPLACEMENT__FIRSTNAME(curIndex)
+                Exit For
+            End If
+        Next curIndex
+    End If
+    
+    MySignature = Replace(MySignature, PATTERN_FIRST_NAME, firstName)
+    MySignature = Replace(MySignature, PATTERN_SENT_DATE, Format(OriginalMail.SentOn, DATE_FORMAT))
+    MySignature = Replace(MySignature, PATTERN_SENDER_NAME, senderName)
+    
+        
+    Dim OutlookHeader As String
+    If CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER Then
+        OutlookHeader = ""
+        'The real condensing is made below, where CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS is checked
+        'Disabling getOutlookHeader leads to an unmodified lineCounter, which in turn gets the header included in "quotedText"
+    Else
+        OutlookHeader = getOutlookHeader(BodyLines, lineCounter)
+    End If
+
+
+    Dim quotedText As String
+    quotedText = getQuotedText(BodyLines, lineCounter)
+    
+    
+    Dim NewText As String
+    'create mail according to reply mode
+    Select Case MailMode
+        Case TypeReply:
+            NewText = quotedText
+        Case TypeReplyAll:
+            NewText = quotedText
+        Case TypeForward:
+            NewText = OutlookHeader & quotedText
+    End Select
+    
+    'Put text in signature (=Template for text)
+    MySignature = Replace(MySignature, PATTERN_OUTLOOK_HEADER & vbCrLf, OutlookHeader)
+    
+    'Stores number of downs to send
+    Dim downCount As Long
+    downCount = -1
+    
+    If InStr(MySignature, PATTERN_QUOTED_TEXT) <> 0 Then
+        If InStr(MySignature, PATTERN_CURSOR_POSITION) = 0 Then
+            'if PATTERN_CURSOR_POSITION is not set, but PATTERN_QUOTED_TEXT is, then the cursor is moved to the quote
+            downCount = CalcDownCount(PATTERN_QUOTED_TEXT, MySignature)
+        End If
+        MySignature = Replace(MySignature, PATTERN_QUOTED_TEXT, NewText)
+    Else
+        'There's no placeholder. Fall back to outlook behavior
+        MySignature = vbCrLf & vbCrLf & MySignature & OutlookHeader & NewText
+    End If
+
+    If (InStr(MySignature, PATTERN_CURSOR_POSITION) <> 0) Then
+        downCount = CalcDownCount(PATTERN_CURSOR_POSITION, MySignature)
+        'remove cursor_position pattern from mail text
+        MySignature = Replace(MySignature, PATTERN_CURSOR_POSITION, "")
+    End If
+    
+    NewMail.Body = MySignature
+    
+    'Extensions, in case Colorize is activated
+    If USE_COLORIZER Then
+        Dim mailID As String
+        mailID = ColorizeMailItem(NewMail)
+        If (Trim("" & mailID) <> "") Then  'no error occured or quotefix macro not there...
+            Call DisplayMailItemByID(mailID)
+        Else
+            'Display window
+            NewMail.Display
+        End If
+    Else
+        'Display window
+        NewMail.Display
+    End If
+
+    'jump to the right place
+    Dim i As Integer
+    For i = 1 To downCount
+        SendKeys "{DOWN}"
+    Next i
+
+    If USE_SOFTWRAP Then
+           Call ResizeWindowForSoftWrap
+    End If
+
+    'mark original mail as read
+    OriginalMail.UnRead = False
+End Sub
+
+
+Private Function getSignature(ByRef BodyLines() As String, ByRef lineCounter As Long) As String
+    
+    ' drop the first two lines, they're empty
+    For lineCounter = 2 To UBound(BodyLines)
+        If (InStr(BodyLines(lineCounter), OUTLOOK_ORIGINALMESSAGE) <> 0) Then
+            If (CalcNesting(BodyLines(lineCounter)).level = 1) Then
+                Exit For
+            End If
+        End If
+        getSignature = getSignature & BodyLines(lineCounter) & vbCrLf
+    Next lineCounter
+
+End Function
+
+Private Function getSenderEmailAdress(ByRef OriginalMail As MailItem) As String
+    Dim senderEmail As String
+    
+    If OriginalMail.SenderEmailType = "SMTP" Then
+        senderEmail = OriginalMail.SenderEmailAddress
+    
+    ElseIf OriginalMail.SenderEmailType = "EX" Then
+        Dim gal As Outlook.AddressList
+        Dim exchAddressEntries As Outlook.AddressEntries
+        Dim exchAddressEntry As Outlook.AddressEntry
+        Dim i As Integer, found As Boolean
+        
+        'FIXME: This seems only to work in Outlook 2007
+        Set gal = OriginalMail.Session.GetGlobalAddressList
+        Set exchAddressEntries = gal.AddressEntries
+        
+        'check if we can get the correct item by sendername
+        Set exchAddressEntry = exchAddressEntries.Item(OriginalMail.senderName)
+        If exchAddressEntry.name <> OriginalMail.senderName Then Set exchAddressEntry = exchAddressEntries.GetFirst
+
+        found = False
+        While (Not found) And (Not exchAddressEntry Is Nothing)
+            found = (LCase(exchAddressEntry.Address) = LCase(OriginalMail.SenderEmailAddress))
+            If Not found Then Set exchAddressEntry = exchAddressEntries.GetNext
+        Wend
+        
+        If Not exchAddressEntry Is Nothing Then
+            senderEmail = exchAddressEntry.GetExchangeUser.PrimarySmtpAddress
+        Else
+            senderEmail = ""
+        End If
+    End If
+    
+    getSenderEmailAdress = senderEmail
+    
+End Function
+
+'Extracts the name of the sender from the sender's name provided in the E-Mail.
+'
+'In:
+'  originalName - name as presented by Outlook
+'Out:
+'  senderName - complete name of sender
+'  firstName - first name of sender
+'Notes:
+'  * Public to enable testing
+'  * Names are returned by reference
+Public Sub getNamesOutOfString(ByVal originalName, ByRef senderName As String, ByRef firstName As String)
+    'Find out firstName
+    
+    Dim tmpName As String
+    tmpName = originalName
+    senderName = originalName
+    
+    'default: fullname
+    firstName = tmpName
+    
+    Dim title As String
+    title = ""
+    'Has to be later used for extracting the last name
+    
+    Dim pos As Integer
+    
+    If (Left(tmpName, 3) = "Dr.") Then
+        tmpName = mid(tmpName, 5)
+        title = "Dr. "
+    End If
+        
+    pos = InStr(tmpName, ",")
+    If pos > 0 Then
+        'Firstname is separated by comma and positioned behind the lastname
+        firstName = Trim(mid(tmpName, pos + 1))
+    Else
+        pos = InStr(tmpName, " ")
+        If pos > 0 Then
+            'first name separated by space
+            firstName = Trim(Left(tmpName, pos - 1))
+            If firstName = UCase(firstName) Then
+                'in case the firstName is written in uppercase letters,
+                'we assume that the lastName is the real firstName
+                firstName = Trim(mid(tmpName, pos + 1))
+            End If
+        Else
+            pos = InStr(tmpName, "@")
+            If pos > 0 Then
+                'first name is (currenty) an eMail-Adress. Just take the prefix
+                tmpName = Left(tmpName, pos - 1)
+            End If
+            pos = InStr(tmpName, ".")
+            If pos > 0 Then
+                'first name is separated by a dot
+                tmpName = Left(tmpName, pos - 1)
+            End If
+            firstName = tmpName
+        End If
+    End If
+    
+    'Take only first word of firstName
+    pos = InStr(firstName, " ")
+    If (pos > 0) Then
+         firstName = Left(firstName, pos - 1)
+    End If
+    
+    'fix casing of names
+    firstName = UCase(Left(firstName, 1)) + LCase(mid(firstName, 2))
+End Sub
+
+
+'Extracts the name of the sender from the sender's name provided in the E-Mail.
+'Future work is to extract the first name out of the stored Outlook contacts (if that contact exists)
+'
+'Notes:
+'  * Names are returned by reference
+Private Sub getNames(ByRef OriginalMail As MailItem, ByRef senderName As String, ByRef firstName As String)
+    
+    'Wildcard replaces
+    senderName = OriginalMail.SentOnBehalfOfName
+    
+    If senderName = "" Then
+        senderName = OriginalMail.senderName
+    End If
+    
+    Call getNamesOutOfString(senderName, senderName, firstName)
+End Sub
+
+
+Private Function getOutlookHeader(ByRef BodyLines() As String, ByRef lineCounter As Long) As String
+
+    ' parse until we find the header finish "> " (Outlook_Headerfinish)
+    
+    For lineCounter = lineCounter To UBound(BodyLines)
+        If (BodyLines(lineCounter) = OUTLOOK_HEADERFINISH) Then
+            Exit For
+        End If
+        getOutlookHeader = getOutlookHeader & BodyLines(lineCounter) & vbCrLf
+    Next lineCounter
+    
+    'skip OUTLOOK_HEADERFINISH
+    lineCounter = lineCounter + 1
+
+End Function
+
+
+Private Function getQuotedText(ByRef BodyLines() As String, ByRef lineCounter As Long) As String
+
+    ' parse the rest of the message
+    For lineCounter = lineCounter To UBound(BodyLines)
+        If STRIP_SIGNATURE And (BodyLines(lineCounter) = SIGNATURE_SEPARATOR) Then
+            'beginning of signature reached
+            Exit For
+        End If
+        
+        getQuotedText = getQuotedText & BodyLines(lineCounter) & vbCrLf
+    Next lineCounter
+    
+    getQuotedText = ReFormatText(getQuotedText)
+
+    If INCLUDE_QUOTES_TO_LEVEL <> -1 Then
+        getQuotedText = StripQuotes(getQuotedText, INCLUDE_QUOTES_TO_LEVEL)
+    End If
+
+End Function
+
+
+Private Function CalcDownCount(pattern As String, textToSearch As String) As Long
+    Dim PosOfPattern As Long
+    Dim TextBeforePattern As String
+    
+    PosOfPattern = InStr(textToSearch, pattern)
+    TextBeforePattern = Left(textToSearch, PosOfPattern - 1)
+    CalcDownCount = CountOccurencesOfStringInString(TextBeforePattern, vbCrLf)
+End Function
+
+
+
+Function GetCurrentItem() As Object  'changed to default scope
+        Dim objApp As Application
+        Set objApp = Session.Application
+        
+        Select Case TypeName(objApp.ActiveWindow)
+            Case "Explorer":  'on clicking reply in the main window
+                Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
+            Case "Inspector": 'on clicking reply when mail is shown in separate window
+                Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
+        End Select
+        
+End Function
+
+'Parameters:
+'  InString: String to count in
+'  What:     What to count
+'Note:
+'  * Order of parameters taken from "InStr"
+Public Function CountOccurencesOfStringInString(InString As String, What As String) As Long
+    Dim count As Long
+    Dim lastPos As Long
+    Dim curPos As Long
+    
+    count = 0
+    lastPos = 0
+    curPos = InStr(InString, What)
+    Do While curPos <> 0
+        lastPos = curPos + 1
+        count = count + 1
+        curPos = InStr(lastPos, InString, What)
+    Loop
+        
+    CountOccurencesOfStringInString = count
+End Function
+
+
+
+Private Function StripQuotes(quotedText As String, stripLevel As Integer) As String
+    Dim quoteLines() As String
+    Dim level As Integer
+    Dim curLine As String
+    Dim res As String
+    Dim i As Integer
+    
+    quoteLines = Split(quotedText, vbCrLf)
+    
+    For i = 1 To UBound(quoteLines)
+        level = InStr(quoteLines(i), " ") - 1
+        If level <= stripLevel Then
+            res = res + quoteLines(i) + vbCrLf
+        End If
+    Next i
+    
+    StripQuotes = res
+End Function
+
+
+'resize window so that the text editor wraps the text automatically
+'after N charaters. Outlook wraps text automatically after sending it,
+'but doesn't display the wrap when editing
+'you can edit the auto wrap setting at "Tools / Options / Email Format / Internet Format"
+Public Sub ResizeWindowForSoftWrap()
+    'Application.ActiveInspector.CurrentItem.Body = SEVENTY_SIX_CHARS
+    If (TypeName(Application.ActiveWindow) = "Inspector") And Not _
+        (Application.ActiveInspector.WindowState = olMaximized) Then
+            
+        Application.ActiveInspector.Width = (LINE_WRAP_AFTER + 2) * PIXEL_PER_CHARACTER
+    End If
+End Sub
+
+
+Public Function ColorizeMailItem(MyMailItem As MailItem) As String
+    Dim folder As MAPIFolder
+    Dim rtf  As String, lines() As String, resRTF As String
+    Dim i As Integer, n As Integer, ret As Integer
+  
+    
+    'save the mailitem to get an entry id, then forget reference to that rtf gets commited.
+    'display mailitem by id later on.
+    If ((Not MyMailItem.BodyFormat = olFormatPlain)) Then 'we just understand Plain Mails
+        ColorizeMailItem = ""
+        Exit Function
+    End If
+       
+    'richt text it
+    MyMailItem.BodyFormat = olFormatRichText
+    MyMailItem.Save  'need to save to be able to access rtf via EntryID (.save creates ExtryID if not saved before)!
+        
+    Set folder = Session.GetDefaultFolder(olFolderInbox)
+    
+    rtf = Space(99999)  'init rtf to max length of message!
+    ret = ReadRTF(Session.CurrentProfileName, MyMailItem.EntryID, folder.StoreID, rtf)
+    If (ret = 0) Then
+        'ole call success!!!
+        rtf = Trim(rtf)  'kill unnecessary spaces (from rtf var init with Space(rtf))
+        Debug.Print rtf & vbCrLf & "*************************************************************" & vbCrLf
+        
+        'we have our own rtf haeder, remove generated one
+        Dim PosHeaderEnd As Integer
+        Dim sTestString As String
+        PosHeaderEnd = InStr(rtf, "\uc1\pard\plain\deftab360")
+        If (PosHeaderEnd = 0) Then
+            sTestString = "\uc1\pard\f0\fs20\lang1031"
+            PosHeaderEnd = InStr(rtf, sTestString)
+        End If
+        If (PosHeaderEnd = 0) Then
+            sTestString = "\viewkind4\uc1\pard\f0\fs20"
+            PosHeaderEnd = InStr(rtf, sTestString)
+        End If
+        If (PosHeaderEnd = 0) Then
+            sTestString = "\pard\f0\fs20\lang1031"
+            PosHeaderEnd = InStr(rtf, sTestString)
+        End If
+        
+        rtf = mid(rtf, PosHeaderEnd + Len(sTestString))
+        
+        rtf = "{\rtf1\ansi\ansicpg1252 \deff0{\fonttbl" & vbCrLf & _
+                "{\f0\fswiss\fcharset0 Courier New;}}" & vbCrLf & _
+                "{\colortbl\red0\green0\blue0;\red106\green44\blue44;\red44\green106\blue44;\red44\green44\blue106;}" & vbCrLf & _
+                rtf
+                
+        lines = Split(rtf, vbCrLf)
+        Dim s As String
+        For i = LBound(lines) To UBound(lines)
+            n = QuoteFixMacro.CalcNesting(lines(i)).level
+            If (n = 0) Then
+                resRTF = resRTF & lines(i) & vbCrLf
+            Else
+                If (Right(lines(i), 4) = "\par") Then
+                    s = Left(lines(i), Len(lines(i)) - Len("\par"))
+                    resRTF = resRTF & "\cf" & n Mod NUM_RTF_COLORS & " " & s & "\cf0  " & "\par" & vbCrLf
+                Else
+                    resRTF = resRTF & "\cf" & n Mod NUM_RTF_COLORS & " " & lines(i) & "\cf0  " & vbCrLf
+                End If
+            End If
+        Next i
+    Else
+        Debug.Print "error while reading rtf! " & ret
+        ColorizeMailItem = ""
+        Exit Function
+    End If
+    
+    'remove some rtf commands
+    resRTF = Replace(resRTF, "\viewkind4\uc1", "")
+    resRTF = Replace(resRTF, "\uc1", "")
+    'VERY IMPORTANT, outlook will change the message back to PlainText otherwise!!!
+    resRTF = Replace(resRTF, "\fromtext", "")
+    Debug.Print resRTF
+    
+       
+    'write RTF back to form
+    ret = WriteRTF(Session.CurrentProfileName, MyMailItem.EntryID, folder.StoreID, resRTF)
+    If (ret = 0) Then
+        Debug.Print "rtf write okay"
+    Else
+        Debug.Print "rtf write FAILURE"
+        ColorizeMailItem = ""
+        Exit Function
+    End If
+    
+    
+    'dereference all objects! otherwise, rtf isn't going to be updated!
+    Set folder = Nothing
+    'save return value
+    ColorizeMailItem = MyMailItem.EntryID
+    Set MyMailItem = Nothing
+End Function
+
+
+Public Sub DisplayMailItemByID(id As String)
+    Dim it As MailItem
+    Set it = Session.GetItemFromID(id, Session.GetDefaultFolder(olFolderInbox).StoreID)
+    it.Display
+    Set it = Nothing
+End Sub

Copied: quotefixmacro/tags/1.5/exampleFirstNameConfiguration.reg (from rev 108, quotefixmacro/trunk/exampleFirstNameConfiguration.reg)
===================================================================
--- quotefixmacro/tags/1.5/exampleFirstNameConfiguration.reg	                        (rev 0)
+++ quotefixmacro/tags/1.5/exampleFirstNameConfiguration.reg	2012-01-11 20:42:01 UTC (rev 109)
@@ -0,0 +1,12 @@
+Windows Registry Editor Version 5.00
+
+[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro\firstnames]
+"Count"="2"
+
+[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro\firstnames\1]
+"email"="jen...@ex..."
+"firstName"="Jenny"
+
+[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro\firstnames\2]
+"email"="A.M...@ex..."
+"firstName"="Adelinde"

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2012-01-11 20:37:08 UTC (rev 108)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2012-01-11 20:42:01 UTC (rev 109)
@@ -1,11 +1,15 @@
 Attribute VB_Name = "QuoteFixMacro"
 '$Id$
-'
-'QuoteFix Macro TRUNK
-'
+
+'QuoteFix Macro 1.5
+
 'QuoteFix Macro is part of the macros4outlook project
 'see http://sourceforge.net/projects/macros4outlook/ for more information
-'
+
+'The page
+'http://sourceforge.net/apps/mediawiki/macros4outlook/index.php?title=QuoteFix_Macro#Configuration
+'provides information about configuration of QuoteFixMacro
+
 'For more information on Outlook see http://www.microsoft.com/outlook
 'Outlook is (C) by Microsoft
 
@@ -96,14 +100,14 @@
 '  * Merged SoftWrap and QuoteColorizerMacro into QuoteFixMacro.bas
 '  * Applied patch 3296731 by Matej Mihelic - Replaced hardcoded call to "MAPI"
 '  * Added LoadConfiguration() so you can store personal settings in the registry. These won\xB4t get lost when updating the macro
-
-'$Revision$ - not released
+'
+'Version 1.5 - 2012-01-11
 '  * bugfix: When a mail was signed or encrypted with PGP, the reformatting would yield incorrect results
 '  * bugfix: When a sender\xB4s name could not be determined correctly, it would have thrown an error 5
 '  * Letters of first name are also lower cased
 '  * Only the first word of a potential first name is used as first name
 '  * support for fixed firstNames for configured email adresses
-'
+
 'Ideas were taken from
 '  * Daniele Bochicchio
 '    Button integration and sample code - http://lab.aspitalia.com/35/Outlook-2007-2003-Reply-With-Quoting-Macro.aspx

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[108] quotefixmacro/trunk/ exampleFirstNameConfiguration.reg

From: <ol...@us...> - 2012-01-11 20:37:14

Revision: 108
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=108&view=rev
Author:   olly98
Date:     2012-01-11 20:37:08 +0000 (Wed, 11 Jan 2012)
Log Message:
-----------
added example .reg file

Added Paths:
-----------
    quotefixmacro/trunk/exampleFirstNameConfiguration.reg

Added: quotefixmacro/trunk/exampleFirstNameConfiguration.reg
===================================================================
--- quotefixmacro/trunk/exampleFirstNameConfiguration.reg	                        (rev 0)
+++ quotefixmacro/trunk/exampleFirstNameConfiguration.reg	2012-01-11 20:37:08 UTC (rev 108)
@@ -0,0 +1,12 @@
+Windows Registry Editor Version 5.00
+
+[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro\firstnames]
+"Count"="2"
+
+[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro\firstnames\1]
+"email"="jen...@ex..."
+"firstName"="Jenny"
+
+[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro\firstnames\2]
+"email"="A.M...@ex..."
+"firstName"="Adelinde"

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[107] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2012-01-11 20:36:52

Revision: 107
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=107&view=rev
Author:   olly98
Date:     2012-01-11 20:36:46 +0000 (Wed, 11 Jan 2012)
Log Message:
-----------
removed obsolete documentation

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2012-01-10 18:58:33 UTC (rev 106)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2012-01-11 20:36:46 UTC (rev 107)
@@ -122,16 +122,6 @@
 Option Explicit
 
 
-'----- HOWTO CONFIGURE FIXED FIRSTNAMES -------------------------------------------------------------------------------
-'1. Open regedit
-'2. Navigate to HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro
-'3. Create key "firstnames"
-'4. Create string (!) "Count" with value X, where X is the number of replacements you want to configure
-'5. Create key "firstnames.1"
-'6. Create string value "email" with the email you want to specify a firstName for
-'7. Create string value "firstName" with the firstname to be used
-'8. Repeat steps 5 to 7 until X is reached. Replace 1 by the appropriate number
-
 '----- DEFAULT CONFIGURATION ------------------------------------------------------------------------------------------
 'The configuration is now stored in the registry
 'Below, the DEFAULT values are provided

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[106] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2012-01-10 18:58:40

Revision: 106
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=106&view=rev
Author:   olly98
Date:     2012-01-10 18:58:33 +0000 (Tue, 10 Jan 2012)
Log Message:
-----------
enabled configured firstNames for emails

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-10-27 10:05:16 UTC (rev 105)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2012-01-10 18:58:33 UTC (rev 106)
@@ -31,7 +31,7 @@
 '
 'QuoteFix Macro
 '  copyright 2006-2009 Oliver Kopp and Daniel Martin. All rights reserved.
-'  copyright 2010-2011 Oliver Kopp and Lars Monsees. All rights reserved.
+'  copyright 2010-2012 Oliver Kopp and Lars Monsees. All rights reserved.
 '
 '
 'Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
@@ -102,6 +102,7 @@
 '  * bugfix: When a sender\xB4s name could not be determined correctly, it would have thrown an error 5
 '  * Letters of first name are also lower cased
 '  * Only the first word of a potential first name is used as first name
+'  * support for fixed firstNames for configured email adresses
 '
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -121,6 +122,16 @@
 Option Explicit
 
 
+'----- HOWTO CONFIGURE FIXED FIRSTNAMES -------------------------------------------------------------------------------
+'1. Open regedit
+'2. Navigate to HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro
+'3. Create key "firstnames"
+'4. Create string (!) "Count" with value X, where X is the number of replacements you want to configure
+'5. Create key "firstnames.1"
+'6. Create string value "email" with the email you want to specify a firstName for
+'7. Create string value "firstName" with the firstname to be used
+'8. Repeat steps 5 to 7 until X is reached. Replace 1 by the appropriate number
+
 '----- DEFAULT CONFIGURATION ------------------------------------------------------------------------------------------
 'The configuration is now stored in the registry
 'Below, the DEFAULT values are provided
@@ -135,6 +146,7 @@
 '    HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro
 Private Const APPNAME As String = "QuoteFixMacro"
 Private Const REG_GROUP_CONFIG As String = "Config"
+Private Const REG_GROUP_FIRSTNAMES As String = "Firstnames" 'stores replacements for firstnames
 
 
 '--------------------------------------------------------
@@ -247,7 +259,11 @@
 Private CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER As Boolean
 Private CONDENSED_HEADER_FORMAT As String
 
+'These are fetched from the registry (LoadConfiguration), but not saved by StoreDefaultConfiguration
+Private FIRSTNAME_REPLACEMENT__EMAIL() As String
+Private FIRSTNAME_REPLACEMENT__FIRSTNAME() As String
 
+
 'For QuoteColorizer
 Public Declare Function WriteRTF _
         Lib "mapirtf.dll" _
@@ -404,6 +420,18 @@
     CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS", DEFAULT_CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS))
     CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER", DEFAULT_CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER))
     CONDENSED_HEADER_FORMAT = GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSED_HEADER_FORMAT", DEFAULT_CONDENSED_HEADER_FORMAT)
+    
+    Dim count As Variant
+    count = CDbl(GetSetting(APPNAME, REG_GROUP_FIRSTNAMES, "Count", 0))
+    ReDim FIRSTNAME_REPLACEMENT__EMAIL(count)
+    ReDim FIRSTNAME_REPLACEMENT__FIRSTNAME(count)
+    Dim i As Integer
+    For i = 1 To count
+        Dim group As String
+        group = REG_GROUP_FIRSTNAMES & "\" & i
+        FIRSTNAME_REPLACEMENT__EMAIL(i) = GetSetting(APPNAME, group, "email", vbNullString)
+        FIRSTNAME_REPLACEMENT__FIRSTNAME(i) = GetSetting(APPNAME, group, "firstName", vbNullString)
+    Next i
 End Sub
 
 'Description:
@@ -864,12 +892,25 @@
     Dim firstName As String
     Call getNames(OriginalMail, senderName, firstName)
     
-    If InStr(MySignature, PATTERN_SENDER_EMAIL) <> 0 Then
+    If (UBound(FIRSTNAME_REPLACEMENT__EMAIL) > 0) Or (InStr(MySignature, PATTERN_SENDER_EMAIL) <> 0) Then
         Dim senderEmail As String
         senderEmail = getSenderEmailAdress(OriginalMail)
         MySignature = Replace(MySignature, PATTERN_SENDER_EMAIL, senderEmail)
     End If
     
+    If (UBound(FIRSTNAME_REPLACEMENT__EMAIL) > 0) Then
+        'replace firstName by email stored in registry
+        Dim rEmail As Variant
+        Dim curIndex As Integer
+        For curIndex = 1 To UBound(FIRSTNAME_REPLACEMENT__EMAIL)
+            rEmail = FIRSTNAME_REPLACEMENT__EMAIL(curIndex)
+            If (StrComp(LCase(senderEmail), LCase(rEmail)) = 0) Then
+                firstName = FIRSTNAME_REPLACEMENT__FIRSTNAME(curIndex)
+                Exit For
+            End If
+        Next curIndex
+    End If
+    
     MySignature = Replace(MySignature, PATTERN_FIRST_NAME, firstName)
     MySignature = Replace(MySignature, PATTERN_SENT_DATE, Format(OriginalMail.SentOn, DATE_FORMAT))
     MySignature = Replace(MySignature, PATTERN_SENDER_NAME, senderName)

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[105] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2011-10-27 10:05:22

Revision: 105
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=105&view=rev
Author:   olly98
Date:     2011-10-27 10:05:16 +0000 (Thu, 27 Oct 2011)
Log Message:
-----------
tweaks concerning the first name

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-10-11 11:01:56 UTC (rev 104)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-10-27 10:05:16 UTC (rev 105)
@@ -100,6 +100,8 @@
 '$Revision$ - not released
 '  * bugfix: When a mail was signed or encrypted with PGP, the reformatting would yield incorrect results
 '  * bugfix: When a sender\xB4s name could not be determined correctly, it would have thrown an error 5
+'  * Letters of first name are also lower cased
+'  * Only the first word of a potential first name is used as first name
 '
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -1065,8 +1067,14 @@
         End If
     End If
     
+    'Take only first word of firstName
+    pos = InStr(firstName, " ")
+    If (pos > 0) Then
+         firstName = Left(firstName, pos - 1)
+    End If
+    
     'fix casing of names
-    firstName = UCase(Left(firstName, 1)) + mid(firstName, 2)
+    firstName = UCase(Left(firstName, 1)) + LCase(mid(firstName, 2))
 End Sub
 
 

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[104] quotefixmacro/trunk/QuoteFixMacro.bas

From: <lar...@us...> - 2011-10-11 11:02:07

Revision: 104
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=104&view=rev
Author:   larsen255
Date:     2011-10-11 11:01:56 +0000 (Tue, 11 Oct 2011)
Log Message:
-----------
bugfix: When a sender?\194?\180s name could not be determined correctly, it would have thrown an error 5

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-09-22 08:04:30 UTC (rev 103)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-10-11 11:01:56 UTC (rev 104)
@@ -99,6 +99,7 @@
 
 '$Revision$ - not released
 '  * bugfix: When a mail was signed or encrypted with PGP, the reformatting would yield incorrect results
+'  * bugfix: When a sender\xB4s name could not be determined correctly, it would have thrown an error 5
 '
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -639,7 +640,14 @@
                     posLeftBracket = InStr(curLine, "[") '[ is the indication of the beginning of the E-Mail-Adress
                     posRightBracket = InStr(curLine, "]")
                     If (posLeftBracket) > 0 Then
-                        sName = mid(curLine, posColon + 2, posLeftBracket - posColon - 3)
+                        Dim lengthName As Integer
+                        lengthName = posLeftBracket - posColon - 3
+                        If lengthName > 0 Then
+                            sName = mid(curLine, posColon + 2, lengthName)
+                        Else
+                            Debug.Print "Couldn\xB4t get name. Is the header formatted correctly?"
+                        End If
+                        
                         If posRightBracket = 0 Then
                             sEmail = mid(curLine, posLeftBracket + 8) '8 = Len("mailto: ")
                         Else

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[103] quotefixmacro/trunk/QuoteFixMacro.bas

From: <lar...@us...> - 2011-09-22 08:04:39

Revision: 103
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=103&view=rev
Author:   larsen255
Date:     2011-09-22 08:04:30 +0000 (Thu, 22 Sep 2011)
Log Message:
-----------
bugfix: When a mail was signed or encrypted with PGP, the reformatting would yield incorrect results

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-07-04 09:50:35 UTC (rev 102)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-09-22 08:04:30 UTC (rev 103)
@@ -98,7 +98,7 @@
 '  * Added LoadConfiguration() so you can store personal settings in the registry. These won\xB4t get lost when updating the macro
 
 '$Revision$ - not released
-'  * <no changes until now>
+'  * bugfix: When a mail was signed or encrypted with PGP, the reformatting would yield incorrect results
 '
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -213,6 +213,7 @@
 'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Urspr\xFCngliche Nachricht-----"
 'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Original Message-----"
 Private Const OUTLOOK_ORIGINALMESSAGE   As String = "> " & OUTLOOK_PLAIN_ORIGINALMESSAGE
+Private Const PGP_MARKER                As String = "-----BEGIN PGP"
 Private Const OUTLOOK_HEADERFINISH      As String = "> "
 Private Const SIGNATURE_SEPARATOR       As String = "> --"
 
@@ -620,7 +621,9 @@
             End If
             
             If CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS Then
-                If Left(curLine, Len(OUTLOOK_PLAIN_ORIGINALMESSAGE)) = OUTLOOK_PLAIN_ORIGINALMESSAGE Then
+                If Left(curLine, Len(OUTLOOK_PLAIN_ORIGINALMESSAGE)) = OUTLOOK_PLAIN_ORIGINALMESSAGE _
+                And Not Left(curLine, Len(PGP_MARKER)) = PGP_MARKER _
+                Then
                     'We found a header
                     
                     Dim posColon As Integer

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[102] quotefixmacro

From: <ol...@us...> - 2011-07-04 09:50:45

Revision: 102
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=102&view=rev
Author:   olly98
Date:     2011-07-04 09:50:35 +0000 (Mon, 04 Jul 2011)

Log Message:
-----------
version as released...

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Added Paths:
-----------
    quotefixmacro/tags/1.4/
    quotefixmacro/tags/1.4/QuoteFixMacro.bas


Property changes on: quotefixmacro/tags/1.4
___________________________________________________________________
Added: bugtraq:number
   + true

Copied: quotefixmacro/tags/1.4/QuoteFixMacro.bas (from rev 101, quotefixmacro/trunk/QuoteFixMacro.bas)
===================================================================
--- quotefixmacro/tags/1.4/QuoteFixMacro.bas	                        (rev 0)
+++ quotefixmacro/tags/1.4/QuoteFixMacro.bas	2011-07-04 09:50:35 UTC (rev 102)
@@ -0,0 +1,1300 @@
+Attribute VB_Name = "QuoteFixMacro"
+'$Id$
+'
+'QuoteFix Macro Version 1.4
+'
+'QuoteFix Macro is part of the macros4outlook project
+'see http://sourceforge.net/projects/macros4outlook/ for more information
+'
+'For more information on Outlook see http://www.microsoft.com/outlook
+'Outlook is (C) by Microsoft
+
+
+'If you like this software, please write a post card to
+'
+'Oliver Kopp
+'Schwabstr. 70a
+'70193 Stuttgart
+'Germany
+'
+'If you don't have money (or don't like the software that much, but
+'appreciate the development), please send an email to
+'mac...@li....
+'
+'For bug reports please go to our sourceforge bugtracker: http://sourceforge.net/projects/macros4outlook/support
+'
+'Thank you :-)
+
+
+'****************************************************************************
+'License:
+'
+'QuoteFix Macro
+'  copyright 2006-2009 Oliver Kopp and Daniel Martin. All rights reserved.
+'  copyright 2010-2011 Oliver Kopp and Lars Monsees. All rights reserved.
+'
+'
+'Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+'
+'   1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+'   2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+'   3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission.
+'
+'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+'****************************************************************************
+
+'Changelog
+'
+'Version 1.0a - 2006-09-14
+' * first public release
+'
+'Version 1.1 - 2006-09-15
+' * Macro %OH introduced
+' * Outlook header contains "> " at the end
+' * If no macros are in the signature, the default behavior of outlook (insert header and quoted text) text is used. (1.0a removed the header)
+'
+'Version 1.2 - 2006-09-25
+' * QuoteFix now also fixes newly introduced first-level-quotes ("> text")
+' * Header matching now matches the English header
+'
+'Version 1.2a - 2006-09-26
+' * quick fix of bug introduced by reformating first-level-quotes
+'   (it was reformated too often)
+'
+'Version 1.2b - 2007-01-24
+' * included on-behalf-of handling written by Per Soderlind (per [at] soderlind [dot] no)
+'
+'Version 1.3 - 2011-04-22
+' * included %C patch 2778722 by Karsten Heimrich
+' * included %SE patch 2807638 by Peter Lindgren
+' * check for beginning of quote is now language independent
+' * added support to strip quotes of level N and greater
+' * more support of alternative name formatting
+'   * added support of reversed name format ("Lastname, Firstname" instead of "Firstname Lastname")
+'   * added support of "LASTNAME firstname" format
+'   * if no firstname is found, then the destination is used
+'     * "firstname.lastname@domain" is supported
+'   * firstName always starts with an uppercase letter
+'   * Added support for "Dr."
+' * added USE_COLORIZER and USE_SOFTWRAP conditional compiling flags.
+'     They enable QuoteColorizerMacro and SoftWrapMacro
+' * splitted code for parsing mailtext from FixMailText() into smaller functions
+' * added support of removing the sender\xB4s signature
+' * bugfix: FinishBlock() would in some cases throw error 5
+' * bugfix: Prevent error 91 when mail is marked as possible phishing mail
+' * Original mail is marked as read
+' * Added CONVERT_TO_PLAIN flag to enable viewing mails as HTML first.
+' * renamed "fromName" to "senderName" in order to reflect real content of the variable
+' * fixed cursor position in the case of absence of "%C", but presence of "%Q"
+'
+'Version 1.4 - 2011-07-04
+'  * Added CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS, which condenses quoted outlook headers
+'    The format of the condensed header is configured at CONDENSED_HEADER_FORMAT
+'  * Added CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER
+'  * Fixed compile time constants to work with Outlook 2007 and 2010
+'  * Added support for custom template configured in the macro (QUOTING_TEMPLATE) - this can be used instead of the signature configuration
+'  * Merged SoftWrap and QuoteColorizerMacro into QuoteFixMacro.bas
+'  * Applied patch 3296731 by Matej Mihelic - Replaced hardcoded call to "MAPI"
+'  * Added LoadConfiguration() so you can store personal settings in the registry. These won\xB4t get lost when updating the macro
+
+'Ideas were taken from
+'  * Daniele Bochicchio
+'    Button integration and sample code - http://lab.aspitalia.com/35/Outlook-2007-2003-Reply-With-Quoting-Macro.aspx
+'  * Dominik Jain
+'    Outlook Quotefix. An excellent program working up to Outlook 2003: http://home.in.tum.de/~jain/software/outlook-quotefix/
+
+'Precondition:
+' * The received mail has to contain the right quotes. Wrong original quotes can not always be fixed
+'   > > > w1
+'   > >
+'   > > w2
+'   > >
+'   > > > w3
+'   won't be fixed to w1 w2 w3. How can it be known, that w2 belongs to w1 and w3?
+
+Option Explicit
+
+
+'----- DEFAULT CONFIGURATION ------------------------------------------------------------------------------------------
+'The configuration is now stored in the registry
+'Below, the DEFAULT values are provided
+'
+'The macro NEVER stores entries in the registry by itself
+'
+'You can store the default configuration in the registry by executing
+'  StoreDefaultConfiguration()
+'or by writing a routing executing commands similar to the following:
+'   Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONVERT_TO_PLAIN", "true")
+'Finally, or by manually creating entries in this registry hive:
+'    HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro
+Private Const APPNAME As String = "QuoteFixMacro"
+Private Const REG_GROUP_CONFIG As String = "Config"
+
+
+'--------------------------------------------------------
+'*** Feature QuoteColorizer ***
+'--------------------------------------------------------
+Private Const DEFAULT_USE_COLORIZER As Boolean = False
+'If you enable it, you need MAPIRTF.DLL in C:\Windows\System32
+'Does NOT work at Windows 7/64bit Outlook 2010/32bit
+'
+'Please enable convert RTF-to-Text at sending. Otherwise, the recipients will always receive HTML E-Mails
+
+'How many different colors should be used for colorizing the quotes?
+Private Const DEFAULT_NUM_RTF_COLORS As Integer = 4
+
+
+'--------------------------------------------------------
+'*** Feature SoftWrap ***
+'--------------------------------------------------------
+'Enable SoftWrap
+'resize window so that the text editor wraps the text automatically
+'after N charaters. Outlook wraps text automatically after sending it,
+'but doesn't display the wrap when editing
+'you can edit the auto wrap setting at "Tools / Options / Email Format / Internet Format"
+Private Const DEFAULT_USE_SOFTWRAP As Boolean = False
+
+'put as much characters as set in Outlook at "Tools / Options / Email Format / Internet Format"
+Private Const DEFAULT_SEVENTY_SIX_CHARS As String = "123456789x123456789x123456789x123456789x123456789x123456789x123456789x123456"
+
+'This constant has to be adapted to fit your needs (incoprating the used font, display size, ...)
+Private Const DEFAULT_PIXEL_PER_CHARACTER As Double = 8.61842105263158
+
+
+'--------------------------------------------------------
+'*** Configuration constants ***
+'--------------------------------------------------------
+'If <> -1, strip quotes with level > INCLUDE_QUOTES_TO_LEVEL
+Private Const DEFAULT_INCLUDE_QUOTES_TO_LEVEL As Integer = -1
+
+'At which column should the text be wrapped?
+Private Const DEFAULT_LINE_WRAP_AFTER As Integer = 75
+
+Private Const DEFAULT_DATE_FORMAT As String = "yyyy-mm-dd"
+'alternative date format
+'Private Const DEFAULT_DATE_FORMAT As String = "ddd, d MMM yyyy at HH:mm:ss"
+
+'Strip the sender\xB4s signature?
+Private Const DEFAULT_STRIP_SIGNATURE As Boolean = True
+
+'Automatically convert HTML/RTF-Mails to plain text?
+Private Const DEFAULT_CONVERT_TO_PLAIN As Boolean = False
+
+'Enable QUOTING_TEMPLATE
+Private Const DEFAULT_USE_QUOTING_TEMPLATE As Boolean = False
+
+'If the constant USE_QUOTING_TEMPLATE is set, this template is used instead of the signature
+Private Const DEFAULT_QUOTING_TEMPLATE As String = _
+"%SN wrote on %D:" & vbCr & _
+"%Q"
+
+
+'--------------------------------------------------------
+'*** Configuration of condensing ***
+'--------------------------------------------------------
+
+'Condense embedded quoted Outlook headers?
+Private Const DEFAULT_CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS As Boolean = True
+
+'Should the first header also be condensed?
+'In case you use a custom header, (e.g., "You wrote on %D:", this should be set to false)
+Private Const DEFAULT_CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER As Boolean = False
+
+'Format of condensed header
+Private Const DEFAULT_CONDENSED_HEADER_FORMAT As String = "%SN wrote on %D:"
+
+'----- END OF DEFAULT CONFIGURATION -----------------------------------------------------------------------------------
+
+
+Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE As String = "-----"
+'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Urspr\xFCngliche Nachricht-----"
+'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Original Message-----"
+Private Const OUTLOOK_ORIGINALMESSAGE   As String = "> " & OUTLOOK_PLAIN_ORIGINALMESSAGE
+Private Const OUTLOOK_HEADERFINISH      As String = "> "
+Private Const SIGNATURE_SEPARATOR       As String = "> --"
+
+Private Const PATTERN_QUOTED_TEXT       As String = "%Q"
+Private Const PATTERN_CURSOR_POSITION   As String = "%C"
+Private Const PATTERN_SENDER_NAME       As String = "%SN"
+Private Const PATTERN_SENDER_EMAIL      As String = "%SE"
+Private Const PATTERN_FIRST_NAME        As String = "%FN"
+Private Const PATTERN_SENT_DATE         As String = "%D"
+Private Const PATTERN_OUTLOOK_HEADER    As String = "%OH"
+
+
+'Variables storing the configuration
+'They are set in LoadConfiguration()
+Private USE_COLORIZER As Boolean
+Private NUM_RTF_COLORS As Integer
+Private USE_SOFTWRAP As Boolean
+Private SEVENTY_SIX_CHARS As String
+Private PIXEL_PER_CHARACTER As Double
+Private INCLUDE_QUOTES_TO_LEVEL As Integer
+Private LINE_WRAP_AFTER As Integer
+Private DATE_FORMAT As String
+Private STRIP_SIGNATURE As Boolean
+Private CONVERT_TO_PLAIN As Boolean
+Private USE_QUOTING_TEMPLATE As Boolean
+Private QUOTING_TEMPLATE As String
+Private CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS As Boolean
+Private CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER As Boolean
+Private CONDENSED_HEADER_FORMAT As String
+
+
+'For QuoteColorizer
+Public Declare Function WriteRTF _
+        Lib "mapirtf.dll" _
+        Alias "writertf" (ByVal ProfileName As String, _
+                          ByVal MessageID As String, _
+                          ByVal StoreID As String, _
+                          ByVal cText As String) _
+        As Integer
+
+'For QuoteColorizer
+Public Declare Function ReadRTF _
+        Lib "mapirtf.dll" _
+        Alias "readrtf" (ByVal ProfileName As String, _
+                         ByVal SrcMsgID As String, _
+                         ByVal SrcStoreID As String, _
+                         ByRef MsgRTF As String) _
+        As Integer
+
+
+Private Enum ReplyType
+    TypeReply = 1
+    TypeReplyAll = 2
+    TypeForward = 3
+End Enum
+
+Public Type NestingType
+    'the level of the current quote plus
+    level As Integer
+    
+    'the amount of spaces until the next word
+    'needed as outlook sometimes inserts more than one space to separate the quoteprefix and the actual quote
+    'we use that information to fix the quote
+    additionalSpacesCount As Integer
+    
+    'total = level + additionalSpacesCount + 1
+    total As Integer
+End Type
+
+'Global Variables to make code more readable (-> parameter passing gets easier)
+Private result As String
+Private unformatedBlock As String
+Private curBlock As String
+Private curBlockNeedsToBeReFormated As Boolean
+Private curPrefix As String
+Private lastLineWasParagraph As Boolean
+Private lastNesting As NestingType
+
+'these are the macros called by the custom buttons
+Sub FixedReply()
+    Dim m As Object
+    Set m = GetCurrentItem()
+
+    Call FixMailText(m, TypeReply)
+End Sub
+
+
+Sub FixedReplyAll()
+    Dim m As Object
+    Set m = GetCurrentItem()
+
+    Call FixMailText(m, TypeReplyAll)
+End Sub
+
+
+Sub FixedForward()
+    Dim m As Object
+    Set m = GetCurrentItem()
+
+    Call FixMailText(m, TypeForward)
+End Sub
+
+
+
+
+
+Function CalcNesting(line As String) As NestingType 'changed to default scope
+    Dim lastQuoteSignPos As Integer
+    Dim i As Integer
+    Dim count As Integer
+    Dim curChar As String
+    Dim res As NestingType
+  
+    count = 0
+    i = 1
+  
+    Do While i <= Len(line)
+        curChar = mid(line, i, 1)
+        If curChar = ">" Then
+            count = count + 1
+            lastQuoteSignPos = i
+        ElseIf curChar <> " " Then
+            'Char is neither ">" nor " " - Quote intro ended
+            'leave function
+            Exit Do
+        End If
+        i = i + 1
+    Loop
+    
+    res.level = count
+  
+    If i <= Len(line) Then
+        'i contains the pos of the first character
+        
+        'if there is no space i = lastQuoteSignPos + 1
+        'One space is normal, the others are nesting
+        '  It could be, that there is no space
+        
+        res.additionalSpacesCount = i - lastQuoteSignPos - 2
+        If res.additionalSpacesCount < 0 Then
+            res.additionalSpacesCount = 0
+        End If
+    Else
+        res.additionalSpacesCount = 0
+    End If
+    
+    res.total = res.level + res.additionalSpacesCount + 1 '+1 = trailing space
+    
+    CalcNesting = res
+End Function
+
+'Stores the default values in the system registry
+Public Sub StoreDefaultConfiguration()
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "USE_COLORIZER", DEFAULT_USE_COLORIZER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "NUM_RTF_COLORS", DEFAULT_NUM_RTF_COLORS)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "USE_SOFTWRAP", DEFAULT_USE_SOFTWRAP)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "SEVENTY_SIX_CHARS", DEFAULT_SEVENTY_SIX_CHARS)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "PIXEL_PER_CHARACTER", DEFAULT_PIXEL_PER_CHARACTER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "INCLUDE_QUOTES_TO_LEVEL", DEFAULT_INCLUDE_QUOTES_TO_LEVEL)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "LINE_WRAP_AFTER", DEFAULT_LINE_WRAP_AFTER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "DATE_FORMAT", DEFAULT_DATE_FORMAT)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "STRIP_SIGNATURE", DEFAULT_STRIP_SIGNATURE)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONVERT_TO_PLAIN", DEFAULT_CONVERT_TO_PLAIN)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "USE_QUOTING_TEMPLATE", DEFAULT_USE_QUOTING_TEMPLATE)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "QUOTING_TEMPLATE", DEFAULT_QUOTING_TEMPLATE)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS", DEFAULT_CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER", DEFAULT_CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSED_HEADER_FORMAT", DEFAULT_CONDENSED_HEADER_FORMAT)
+End Sub
+
+'Loads the personal settings from the registry.
+Private Sub LoadConfiguration()
+    USE_COLORIZER = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_COLORIZER", DEFAULT_USE_COLORIZER))
+    NUM_RTF_COLORS = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "NUM_RTF_COLORS", DEFAULT_NUM_RTF_COLORS))
+    USE_SOFTWRAP = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_SOFTWRAP", DEFAULT_USE_SOFTWRAP))
+    SEVENTY_SIX_CHARS = GetSetting(APPNAME, REG_GROUP_CONFIG, "SEVENTY_SIX_CHARS", DEFAULT_SEVENTY_SIX_CHARS)
+    PIXEL_PER_CHARACTER = CDbl(GetSetting(APPNAME, REG_GROUP_CONFIG, "PIXEL_PER_CHARACTER", DEFAULT_PIXEL_PER_CHARACTER))
+    INCLUDE_QUOTES_TO_LEVEL = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "INCLUDE_QUOTES_TO_LEVEL", DEFAULT_INCLUDE_QUOTES_TO_LEVEL))
+    LINE_WRAP_AFTER = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "LINE_WRAP_AFTER", DEFAULT_LINE_WRAP_AFTER))
+    DATE_FORMAT = GetSetting(APPNAME, REG_GROUP_CONFIG, "DATE_FORMAT", DEFAULT_DATE_FORMAT)
+    STRIP_SIGNATURE = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "STRIP_SIGNATURE", DEFAULT_STRIP_SIGNATURE))
+    CONVERT_TO_PLAIN = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONVERT_TO_PLAIN", DEFAULT_CONVERT_TO_PLAIN))
+    USE_QUOTING_TEMPLATE = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_QUOTING_TEMPLATE", DEFAULT_USE_QUOTING_TEMPLATE))
+    QUOTING_TEMPLATE = GetSetting(APPNAME, REG_GROUP_CONFIG, "QUOTING_TEMPLATE", DEFAULT_QUOTING_TEMPLATE)
+    CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS", DEFAULT_CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS))
+    CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER", DEFAULT_CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER))
+    CONDENSED_HEADER_FORMAT = GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSED_HEADER_FORMAT", DEFAULT_CONDENSED_HEADER_FORMAT)
+End Sub
+
+'Description:
+'   Strips away ">" and " " at the beginning to have the plain text
+Private Function StripLine(line As String) As String
+    Dim res As String
+    res = line
+    
+    Do While (Len(res) > 0) And (InStr("> ", Left(res, 1)) <> 0)
+        'First character is a space or a quote
+        res = mid(res, 2)
+    Loop
+    
+    'Remove the spaces at the end of res
+    res = Trim(res)
+    
+    StripLine = res
+End Function
+
+Private Function CalcPrefix(ByRef nesting As NestingType) As String
+    Dim res As String
+    
+    res = String(nesting.level, ">")
+    res = res & String(nesting.additionalSpacesCount, " ")
+    
+    CalcPrefix = res & " "
+End Function
+
+'Description:
+'   Adds the current line to unfomatedBlock and to curBlock
+Private Sub AppendCurLine(ByRef curLine As String)
+    If unformatedBlock = "" Then
+        'unformatedBlock has to be used here, because it might be the case that the first
+        '  line is "". Therefore curBlock remains "", whereas unformatedBlock gets <> ""
+        
+        If curLine = "" Then Exit Sub
+        
+        curBlock = curLine
+        unformatedBlock = curPrefix & curLine & vbCrLf
+    Else
+        curBlock = curBlock & IIf(curBlock = "", "", " ") & curLine
+        unformatedBlock = unformatedBlock & curPrefix & curLine & vbCrLf
+    End If
+End Sub
+
+Private Sub HandleParagraph(ByRef prefix As String)
+    If Not lastLineWasParagraph Then
+        FinishBlock lastNesting
+        lastLineWasParagraph = True
+    Else
+        'lastline was already a paragraph. No further action required
+    End If
+    
+    'Add a new line in all cases...
+    result = result & prefix & vbCrLf
+End Sub
+
+'Description:
+'   Finishes the current Block
+'
+'   Also resets
+'       curBlockNeedsToBeReFormated
+'       curBlock
+'       unformatedBlock
+Private Sub FinishBlock(ByRef nesting As NestingType)
+    If Not curBlockNeedsToBeReFormated Then
+        result = result & unformatedBlock
+    Else
+        'reformat curBlock and append it
+        Dim prefix As String
+        Dim curLine As String
+        Dim maxLength As Integer
+        Dim i As Integer
+    
+        prefix = CalcPrefix(nesting)
+    
+        maxLength = LINE_WRAP_AFTER - nesting.total
+    
+        Do While Len(curBlock) > maxLength
+            'go through block from maxLength to beginning to find a space
+            i = maxLength
+            If i > 0 Then
+                Do While (mid(curBlock, i, 1) <> " ")
+                    i = i - 1
+                    If i = 0 Then Exit Do
+                Loop
+            End If
+    
+            If i = 0 Then
+                'No space found -> use the full line
+                curLine = Left(curBlock, maxLength)
+                curBlock = mid(curBlock, maxLength + 1)
+            Else
+                curLine = Left(curBlock, i - 1)
+                curBlock = mid(curBlock, i + 1)
+            End If
+    
+            result = result & prefix & curLine & vbCrLf
+        Loop
+    
+        If Len(curBlock) > 0 Then
+            result = result & prefix & curBlock & vbCrLf
+        End If
+    End If
+    
+    'Resetting
+    curBlockNeedsToBeReFormated = False
+    curBlock = ""
+    unformatedBlock = ""
+    'lastLineWasParagraph = False
+End Sub
+
+'Reformat text to correct broken wrap inserted by Outlook.
+'Needs to be public so the test cases can run this function.
+Public Function ReFormatText(text As String) As String
+    Dim curLine As String
+    Dim rows() As String
+    Dim lastPrefix As String
+    Dim i As Long
+    Dim curNesting As NestingType
+    Dim nextNesting As NestingType
+
+    'Reset (partially global) variables
+    result = ""
+    curBlock = ""
+    unformatedBlock = ""
+    curNesting.level = 0
+    lastNesting.level = 0
+    curBlockNeedsToBeReFormated = False
+    
+    rows = Split(text, vbCrLf)
+    
+    For i = LBound(rows) To UBound(rows)
+        curLine = StripLine(rows(i))
+        lastNesting = curNesting
+        curNesting = CalcNesting(rows(i))
+        
+        If curNesting.total <> lastNesting.total Then
+            lastPrefix = curPrefix
+            curPrefix = CalcPrefix(curNesting)
+        End If
+        
+        If curNesting.total = lastNesting.total Then
+            'Quote continues
+            If curLine = "" Then
+                'new paragraph has started
+                HandleParagraph curPrefix
+            Else
+                AppendCurLine curLine
+                lastLineWasParagraph = False
+            
+                If (curNesting.level = 1) And (i < UBound(rows)) Then
+                    'check if the next line contains a wrong break
+                    nextNesting = CalcNesting(rows(i + 1))
+                    If (CountOccurencesOfStringInString(curLine, " ") = 0) And (curNesting.total = nextNesting.total) _
+                        And (Len(rows(i - 1)) > LINE_WRAP_AFTER - Len(curLine) - 10) Then '10 is only a rough heuristics... - should be improved
+                        'Yes, it is a wrong Wrap (same recognition as below)
+                        curBlockNeedsToBeReFormated = True
+                    End If
+                End If
+            End If
+        
+        ElseIf curNesting.total < lastNesting.total Then 'curNesting.level = lastNesting.level - 1 doesn't work, because ">>", ">>>", ... are also killed by Office
+            lastLineWasParagraph = False
+            
+            'Quote is indented less. Maybe it's a wrong line wrap of outlook?
+            
+            If (i < UBound(rows)) Then
+                nextNesting = CalcNesting(rows(i + 1))
+                If nextNesting.total = lastNesting.total Then
+                    'Yeah. Wrong line wrap found
+                    
+                    If curLine = "" Then
+                        'The linebreak has to be interpreted as paragraph
+                        'new Paragraph has started. No joining of quotes is necessary
+                        HandleParagraph lastPrefix
+                    Else
+                        curBlockNeedsToBeReFormated = True
+                    
+                        'nesting and prefix have to be adjusted
+                        curNesting = lastNesting
+                        curPrefix = lastPrefix
+                    
+                        AppendCurLine curLine
+                    End If
+                Else
+                    'No wrong line wrap found. Last block is finished
+                    FinishBlock lastNesting
+                    
+                    If curLine = "" Then
+                        If curNesting.level <> lastNesting.level Then
+                            lastLineWasParagraph = True
+                            HandleParagraph curPrefix
+                        End If
+                    End If
+                    
+                    'next block starts with curLine
+                    AppendCurLine curLine
+                End If
+            Else
+                'Quote is the last one - just use it
+                AppendCurLine curLine
+            End If
+        
+        Else
+            'curNesting.total > lastNesting.total
+            
+            lastLineWasParagraph = False
+            
+            'it's nested one level deeper. Current block is finished
+            FinishBlock lastNesting
+        
+            If curLine = "" Then
+                If curNesting.level <> lastNesting.level Then
+                    lastLineWasParagraph = True
+                    HandleParagraph curPrefix
+                End If
+            End If
+            
+            If CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS Then
+                If Left(curLine, Len(OUTLOOK_PLAIN_ORIGINALMESSAGE)) = OUTLOOK_PLAIN_ORIGINALMESSAGE Then
+                    'We found a header
+                    
+                    Dim posColon As Integer
+                    
+                    'Name and Email
+                    i = i + 1
+                    Dim sName As String
+                    Dim sEmail As String
+                    curLine = StripLine(rows(i))
+                    posColon = InStr(curLine, ":")
+                    Dim posLeftBracket As String
+                    Dim posRightBracket As Integer
+                    posLeftBracket = InStr(curLine, "[") '[ is the indication of the beginning of the E-Mail-Adress
+                    posRightBracket = InStr(curLine, "]")
+                    If (posLeftBracket) > 0 Then
+                        sName = mid(curLine, posColon + 2, posLeftBracket - posColon - 3)
+                        If posRightBracket = 0 Then
+                            sEmail = mid(curLine, posLeftBracket + 8) '8 = Len("mailto: ")
+                        Else
+                            sEmail = mid(curLine, posLeftBracket + 8, posRightBracket - posLeftBracket - 8) '8 = Len("mailto: ")
+                        End If
+                    Else
+                        sName = mid(curLine, posColon + 2)
+                        sEmail = ""
+                    End If
+                    
+                    i = i + 1
+                    curLine = StripLine(rows(i))
+                    If InStr(curLine, ":") = 0 Then
+                        'There is a wrap in the email-Adress
+                        posRightBracket = InStr(curLine, "]")
+                        If posRightBracket > 0 Then
+                            sEmail = sEmail + Left(curLine, posRightBracket - 1)
+                        Else
+                            'something wrent wrong, do nothing
+                        End If
+                        'go to next line
+                        i = i + 1
+                        curLine = StripLine(rows(i))
+                    End If
+                    
+                    'Date
+                    'We assume that there is always a weekday present before the date
+                    Dim sDate As String
+                    sDate = StripLine(rows(i))
+                    'posColon = InStr(sDate, ":")
+                    'sDate = mid(sDate, posColon + 2)
+                    Dim posFirstComma As Integer
+                    posFirstComma = InStr(sDate, ",")
+                    sDate = mid(sDate, posFirstComma + 2)
+                    Dim dDate As Date
+                    If IsDate(sDate) Then
+                        dDate = DateValue(sDate)
+                        'there is no function "IsTime", therefore try with brute force
+                        dDate = dDate + TimeValue(sDate)
+                    End If
+                    If dDate <> CDate("00:00:00") Then
+                        sDate = Format(dDate, DATE_FORMAT)
+                    Else
+                        'leave sDate as is -> date is output as found in email
+                    End If
+                    
+                    i = i + 3 'skip next three lines (To, [possibly CC], Subject, empty line)
+                    'if CC exists, then i points to the empty line
+                    'if CC does not exist, then i points to the first non-empty line
+                    
+                    'Strip empty lines
+                    Do
+                        i = i + 1
+                        curLine = StripLine(rows(i))
+                    Loop Until (curLine <> "") Or (i = UBound(rows))
+                    i = i - 1 'i now points to the last empty line
+                    
+                    Dim condensedHeader As String
+                    condensedHeader = CONDENSED_HEADER_FORMAT
+                    condensedHeader = Replace(condensedHeader, PATTERN_SENDER_NAME, sName)
+                    condensedHeader = Replace(condensedHeader, PATTERN_SENT_DATE, sDate)
+                    condensedHeader = Replace(condensedHeader, PATTERN_SENDER_EMAIL, sEmail)
+                    
+                    Dim prefix As String
+                    'the prefix for the result has to be one level shorter as it is the quoted text from the sender
+                    If (curNesting.level = 1) Then
+                        prefix = ""
+                    Else
+                        prefix = mid(curPrefix, 2)
+                    End If
+                    
+                    result = result & prefix & condensedHeader & vbCrLf
+                Else
+                    'fall back to default behavior
+                    'next block starts with curLine
+                    AppendCurLine curLine
+                End If
+            Else
+                'next block starts with curLine
+                AppendCurLine curLine
+            End If
+        End If
+    Next i
+    
+    'Finish current Block
+    FinishBlock curNesting
+    
+    'strip last (unnecessary) line feeds and spaces
+    Do While ((Len(result) > 0) And (InStr(vbCr & vbLf & " ", Right(result, 1)) <> 0))
+        result = Left(result, Len(result) - 1)
+    Loop
+    
+    ReFormatText = result
+End Function
+
+
+Private Sub FixMailText(SelectedObject As Object, MailMode As ReplyType)
+    Dim TempObj As Object
+    
+    
+    Call LoadConfiguration
+   
+    
+    'we only understand mail items, no PostItems, NoteItems, ...
+    If Not (TypeName(SelectedObject) = "MailItem") Then
+        On Error GoTo catch:   'try, catch replacement
+        Dim HadError As Boolean
+        HadError = True
+                          
+        Select Case MailMode
+            Case TypeReply:
+                Set TempObj = SelectedObject.Reply
+                TempObj.Display
+                HadError = False
+                Exit Sub
+            Case TypeReplyAll:
+                Set TempObj = SelectedObject.ReplyAll
+                TempObj.Display
+                HadError = False
+                Exit Sub
+            Case TypeForward:
+                Set TempObj = SelectedObject.Forward
+                TempObj.Display
+                HadError = False
+                Exit Sub
+        End Select
+        
+catch:
+        On Error GoTo 0  'deactivate errorhandling
+        
+        If (HadError = True) Then
+            'reply / replyall / forward caused error
+            ' -->  just display it
+            SelectedObject.Display
+            Exit Sub
+        End If
+    End If
+
+    Dim OriginalMail As MailItem
+    Set OriginalMail = SelectedObject  'cast!!!
+    
+    
+    'mails that have not been sent can\xB4t be replied to (draft mails)
+    If Not OriginalMail.Sent Then
+        MsgBox "This mail seems to be a draft, so it cannot be replied to.", vbExclamation
+        Exit Sub
+    End If
+    
+    'we don\xB4t understand HTML mails!!!
+    If Not (OriginalMail.BodyFormat = olFormatPlain) Then
+        If CONVERT_TO_PLAIN Then
+            'Unfortunately, it\xB4s only possible to convert the original mail as there is
+            'no easy way to create a clone. Therefore, you cannot go back to the original format!
+            'If you e.g. would decide that you need to forward the mail in HTML format,
+            'this will not be possible anymore.
+            SelectedObject.BodyFormat = olFormatPlain
+        Else
+            Dim ReplyObj As MailItem
+            
+            Select Case MailMode
+                Case TypeReply:
+                    Set ReplyObj = OriginalMail.Reply
+                Case TypeReplyAll:
+                    Set ReplyObj = OriginalMail.ReplyAll
+                Case TypeForward:
+                    Set ReplyObj = OriginalMail.Forward
+            End Select
+            
+            ReplyObj.Display
+            Exit Sub
+        End If
+    End If
+    
+    'create reply --> outlook style!
+    Dim NewMail As MailItem
+    Select Case MailMode
+        Case TypeReply:
+            Set NewMail = OriginalMail.Reply
+        Case TypeReplyAll:
+            Set NewMail = OriginalMail.ReplyAll
+        Case TypeForward:
+            Set NewMail = OriginalMail.Forward
+    End Select
+    
+    'if the mail is marked as a possible phishing mail, a warning will be shown and
+    'the reply methods will return null (forward method is ok)
+    If NewMail Is Nothing Then Exit Sub
+    
+    'put the whole mail as composed by Outlook into an array
+    Dim BodyLines() As String
+    BodyLines = Split(NewMail.Body, vbCrLf)
+    
+    'lineCounter is used to provide information about how many lines we already parsed.
+    'This variable is always passed to the various parser functions by reference to get
+    'back the new value.
+    Dim lineCounter As Long
+
+    ' A new mail starts with signature -if- set, try to parse until we find the the
+    ' original message separator - might loop until the end of the whole message since
+    ' this depends on the International Option settings (english), even worse it might
+    ' find some separator in-between and mess up the whole reply, so check the nesting too.
+    Dim MySignature As String
+    MySignature = getSignature(BodyLines, lineCounter)
+    ' lineCounter now indicates the line after the signature
+   
+    If USE_QUOTING_TEMPLATE Then
+        'Override MySignature in case the QUOTING_TEMPLATE should be used
+        MySignature = QUOTING_TEMPLATE
+    End If
+
+    Dim senderName As String
+    Dim firstName As String
+    Call getNames(OriginalMail, senderName, firstName)
+    
+    If InStr(MySignature, PATTERN_SENDER_EMAIL) <> 0 Then
+        Dim senderEmail As String
+        senderEmail = getSenderEmailAdress(OriginalMail)
+        MySignature = Replace(MySignature, PATTERN_SENDER_EMAIL, senderEmail)
+    End If
+    
+    MySignature = Replace(MySignature, PATTERN_FIRST_NAME, firstName)
+    MySignature = Replace(MySignature, PATTERN_SENT_DATE, Format(OriginalMail.SentOn, DATE_FORMAT))
+    MySignature = Replace(MySignature, PATTERN_SENDER_NAME, senderName)
+    
+        
+    Dim OutlookHeader As String
+    If CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER Then
+        OutlookHeader = ""
+        'The real condensing is made below, where CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS is checked
+        'Disabling getOutlookHeader leads to an unmodified lineCounter, which in turn gets the header included in "quotedText"
+    Else
+        OutlookHeader = getOutlookHeader(BodyLines, lineCounter)
+    End If
+
+
+    Dim quotedText As String
+    quotedText = getQuotedText(BodyLines, lineCounter)
+    
+    
+    Dim NewText As String
+    'create mail according to reply mode
+    Select Case MailMode
+        Case TypeReply:
+            NewText = quotedText
+        Case TypeReplyAll:
+            NewText = quotedText
+        Case TypeForward:
+            NewText = OutlookHeader & quotedText
+    End Select
+    
+    'Put text in signature (=Template for text)
+    MySignature = Replace(MySignature, PATTERN_OUTLOOK_HEADER & vbCrLf, OutlookHeader)
+    
+    'Stores number of downs to send
+    Dim downCount As Long
+    downCount = -1
+    
+    If InStr(MySignature, PATTERN_QUOTED_TEXT) <> 0 Then
+        If InStr(MySignature, PATTERN_CURSOR_POSITION) = 0 Then
+            'if PATTERN_CURSOR_POSITION is not set, but PATTERN_QUOTED_TEXT is, then the cursor is moved to the quote
+            downCount = CalcDownCount(PATTERN_QUOTED_TEXT, MySignature)
+        End If
+        MySignature = Replace(MySignature, PATTERN_QUOTED_TEXT, NewText)
+    Else
+        'There's no placeholder. Fall back to outlook behavior
+        MySignature = vbCrLf & vbCrLf & MySignature & OutlookHeader & NewText
+    End If
+
+    If (InStr(MySignature, PATTERN_CURSOR_POSITION) <> 0) Then
+        downCount = CalcDownCount(PATTERN_CURSOR_POSITION, MySignature)
+        'remove cursor_position pattern from mail text
+        MySignature = Replace(MySignature, PATTERN_CURSOR_POSITION, "")
+    End If
+    
+    NewMail.Body = MySignature
+    
+    'Extensions, in case Colorize is activated
+    If USE_COLORIZER Then
+        Dim mailID As String
+        mailID = ColorizeMailItem(NewMail)
+        If (Trim("" & mailID) <> "") Then  'no error occured or quotefix macro not there...
+            Call DisplayMailItemByID(mailID)
+        Else
+            'Display window
+            NewMail.Display
+        End If
+    Else
+        'Display window
+        NewMail.Display
+    End If
+
+    'jump to the right place
+    Dim i As Integer
+    For i = 1 To downCount
+        SendKeys "{DOWN}"
+    Next i
+
+    If USE_SOFTWRAP Then
+           Call ResizeWindowForSoftWrap
+    End If
+
+    'mark original mail as read
+    OriginalMail.UnRead = False
+End Sub
+
+
+Private Function getSignature(ByRef BodyLines() As String, ByRef lineCounter As Long) As String
+    
+    ' drop the first two lines, they're empty
+    For lineCounter = 2 To UBound(BodyLines)
+        If (InStr(BodyLines(lineCounter), OUTLOOK_ORIGINALMESSAGE) <> 0) Then
+            If (CalcNesting(BodyLines(lineCounter)).level = 1) Then
+                Exit For
+            End If
+        End If
+        getSignature = getSignature & BodyLines(lineCounter) & vbCrLf
+    Next lineCounter
+
+End Function
+
+Private Function getSenderEmailAdress(ByRef OriginalMail As MailItem) As String
+    Dim senderEmail As String
+    
+    If OriginalMail.SenderEmailType = "SMTP" Then
+        senderEmail = OriginalMail.SenderEmailAddress
+    
+    ElseIf OriginalMail.SenderEmailType = "EX" Then
+        Dim gal As Outlook.AddressList
+        Dim exchAddressEntries As Outlook.AddressEntries
+        Dim exchAddressEntry As Outlook.AddressEntry
+        Dim i As Integer, found As Boolean
+        
+        'FIXME: This seems only to work in Outlook 2007
+        Set gal = OriginalMail.Session.GetGlobalAddressList
+        Set exchAddressEntries = gal.AddressEntries
+        
+        'check if we can get the correct item by sendername
+        Set exchAddressEntry = exchAddressEntries.Item(OriginalMail.senderName)
+        If exchAddressEntry.name <> OriginalMail.senderName Then Set exchAddressEntry = exchAddressEntries.GetFirst
+
+        found = False
+        While (Not found) And (Not exchAddressEntry Is Nothing)
+            found = (LCase(exchAddressEntry.Address) = LCase(OriginalMail.SenderEmailAddress))
+            If Not found Then Set exchAddressEntry = exchAddressEntries.GetNext
+        Wend
+        
+        If Not exchAddressEntry Is Nothing Then
+            senderEmail = exchAddressEntry.GetExchangeUser.PrimarySmtpAddress
+        Else
+            senderEmail = ""
+        End If
+    End If
+    
+    getSenderEmailAdress = senderEmail
+    
+End Function
+
+'Extracts the name of the sender from the sender's name provided in the E-Mail.
+'
+'In:
+'  originalName - name as presented by Outlook
+'Out:
+'  senderName - complete name of sender
+'  firstName - first name of sender
+'Notes:
+'  * Public to enable testing
+'  * Names are returned by reference
+Public Sub getNamesOutOfString(ByVal originalName, ByRef senderName As String, ByRef firstName As String)
+    'Find out firstName
+    
+    Dim tmpName As String
+    tmpName = originalName
+    senderName = originalName
+    
+    'default: fullname
+    firstName = tmpName
+    
+    Dim title As String
+    title = ""
+    'Has to be later used for extracting the last name
+    
+    Dim pos As Integer
+    
+    If (Left(tmpName, 3) = "Dr.") Then
+        tmpName = mid(tmpName, 5)
+        title = "Dr. "
+    End If
+        
+    pos = InStr(tmpName, ",")
+    If pos > 0 Then
+        'Firstname is separated by comma and positioned behind the lastname
+        firstName = Trim(mid(tmpName, pos + 1))
+    Else
+        pos = InStr(tmpName, " ")
+        If pos > 0 Then
+            'first name separated by space
+            firstName = Trim(Left(tmpName, pos - 1))
+            If firstName = UCase(firstName) Then
+                'in case the firstName is written in uppercase letters,
+                'we assume that the lastName is the real firstName
+                firstName = Trim(mid(tmpName, pos + 1))
+            End If
+        Else
+            pos = InStr(tmpName, "@")
+            If pos > 0 Then
+                'first name is (currenty) an eMail-Adress. Just take the prefix
+                tmpName = Left(tmpName, pos - 1)
+            End If
+            pos = InStr(tmpName, ".")
+            If pos > 0 Then
+                'first name is separated by a dot
+                tmpName = Left(tmpName, pos - 1)
+            End If
+            firstName = tmpName
+        End If
+    End If
+    
+    'fix casing of names
+    firstName = UCase(Left(firstName, 1)) + mid(firstName, 2)
+End Sub
+
+
+'Extracts the name of the sender from the sender's name provided in the E-Mail.
+'Future work is to extract the first name out of the stored Outlook contacts (if that contact exists)
+'
+'Notes:
+'  * Names are returned by reference
+Private Sub getNames(ByRef OriginalMail As MailItem, ByRef senderName As String, ByRef firstName As String)
+    
+    'Wildcard replaces
+    senderName = OriginalMail.SentOnBehalfOfName
+    
+    If senderName = "" Then
+        senderName = OriginalMail.senderName
+    End If
+    
+    Call getNamesOutOfString(senderName, senderName, firstName)
+End Sub
+
+
+Private Function getOutlookHeader(ByRef BodyLines() As String, ByRef lineCounter As Long) As String
+
+    ' parse until we find the header finish "> " (Outlook_Headerfinish)
+    
+    For lineCounter = lineCounter To UBound(BodyLines)
+        If (BodyLines(lineCounter) = OUTLOOK_HEADERFINISH) Then
+            Exit For
+        End If
+        getOutlookHeader = getOutlookHeader & BodyLines(lineCounter) & vbCrLf
+    Next lineCounter
+    
+    'skip OUTLOOK_HEADERFINISH
+    lineCounter = lineCounter + 1
+
+End Function
+
+
+Private Function getQuotedText(ByRef BodyLines() As String, ByRef lineCounter As Long) As String
+
+    ' parse the rest of the message
+    For lineCounter = lineCounter To UBound(BodyLines)
+        If STRIP_SIGNATURE And (BodyLines(lineCounter) = SIGNATURE_SEPARATOR) Then
+            'beginning of signature reached
+            Exit For
+        End If
+        
+        getQuotedText = getQuotedText & BodyLines(lineCounter) & vbCrLf
+    Next lineCounter
+    
+    getQuotedText = ReFormatText(getQuotedText)
+
+    If INCLUDE_QUOTES_TO_LEVEL <> -1 Then
+        getQuotedText = StripQuotes(getQuotedText, INCLUDE_QUOTES_TO_LEVEL)
+    End If
+
+End Function
+
+
+Private Function CalcDownCount(pattern As String, textToSearch As String) As Long
+    Dim PosOfPattern As Long
+    Dim TextBeforePattern As String
+    
+    PosOfPattern = InStr(textToSearch, pattern)
+    TextBeforePattern = Left(textToSearch, PosOfPattern - 1)
+    CalcDownCount = CountOccurencesOfStringInString(TextBeforePattern, vbCrLf)
+End Function
+
+
+
+Function GetCurrentItem() As Object  'changed to default scope
+        Dim objApp As Application
+        Set objApp = Session.Application
+        
+        Select Case TypeName(objApp.ActiveWindow)
+            Case "Explorer":  'on clicking reply in the main window
+                Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
+            Case "Inspector": 'on clicking reply when mail is shown in separate window
+                Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
+        End Select
+        
+End Function
+
+'Parameters:
+'  InString: String to count in
+'  What:     What to count
+'Note:
+'  * Order of parameters taken from "InStr"
+Public Function CountOccurencesOfStringInString(InString As String, What As String) As Long
+    Dim count As Long
+    Dim lastPos As Long
+    Dim curPos As Long
+    
+    count = 0
+    lastPos = 0
+    curPos = InStr(InString, What)
+    Do While curPos <> 0
+        lastPos = curPos + 1
+        count = count + 1
+        curPos = InStr(lastPos, InString, What)
+    Loop
+        
+    CountOccurencesOfStringInString = count
+End Function
+
+
+
+Private Function StripQuotes(quotedText As String, stripLevel As Integer) As String
+    Dim quoteLines() As String
+    Dim level As Integer
+    Dim curLine As String
+    Dim res As String
+    Dim i As Integer
+    
+    quoteLines = Split(quotedText, vbCrLf)
+    
+    For i = 1 To UBound(quoteLines)
+        level = InStr(quoteLines(i), " ") - 1
+        If level <= stripLevel Then
+            res = res + quoteLines(i) + vbCrLf
+        End If
+    Next i
+    
+    StripQuotes = res
+End Function
+
+
+'resize window so that the text editor wraps the text automatically
+'after N charaters. Outlook wraps text automatically after sending it,
+'but doesn't display the wrap when editing
+'you can edit the auto wrap setting at "Tools / Options / Email Format / Internet Format"
+Public Sub ResizeWindowForSoftWrap()
+    'Application.ActiveInspector.CurrentItem.Body = SEVENTY_SIX_CHARS
+    If (TypeName(Application.ActiveWindow) = "Inspector") And Not _
+        (Application.ActiveInspector.WindowState = olMaximized) Then
+            
+        Application.ActiveInspector.Width = (LINE_WRAP_AFTER + 2) * PIXEL_PER_CHARACTER
+    End If
+End Sub
+
+
+Public Function ColorizeMailItem(MyMailItem As MailItem) As String
+    Dim folder As MAPIFolder
+    Dim rtf  As String, lines() As String, resRTF As String
+    Dim i As Integer, n As Integer, ret As Integer
+  
+    
+    'save the mailitem to get an entry id, then forget reference to that rtf gets commited.
+    'display mailitem by id later on.
+    If ((Not MyMailItem.BodyFormat = olFormatPlain)) Then 'we just understand Plain Mails
+        ColorizeMailItem = ""
+        Exit Function
+    End If
+       
+    'richt text it
+    MyMailItem.BodyFormat = olFormatRichText
+    MyMailItem.Save  'need to save to be able to access rtf via EntryID (.save creates ExtryID if not saved before)!
+        
+    Set folder = Session.GetDefaultFolder(olFolderInbox)
+    
+    rtf = Space(99999)  'init rtf to max length of message!
+    ret = ReadRTF(Session.CurrentProfileName, MyMailItem.EntryID, folder.StoreID, rtf)
+    If (ret = 0) Then
+        'ole call success!!!
+        rtf = Trim(rtf)  'kill unnecessary spaces (from rtf var init with Space(rtf))
+        Debug.Print rtf & vbCrLf & "*************************************************************" & vbCrLf
+        
+        'we have our own rtf haeder, remove generated one
+        Dim PosHeaderEnd As Integer
+        Dim sTestString As String
+        PosHeaderEnd = InStr(rtf, "\uc1\pard\plain\deftab360")
+        If (PosHeaderEnd = 0) Then
+            sTestString = "\uc1\pard\f0\fs20\lang1031"
+            PosHeaderEnd = InStr(rtf, sTestString)
+        End If
+        If (PosHeaderEnd = 0) Then
+            sTestString = "\viewkind4\uc1\pard\f0\fs20"
+            PosHeaderEnd = InStr(rtf, sTestString)
+        End If
+        If (PosHeaderEnd = 0) Then
+            sTestString = "\pard\f0\fs20\lang1031"
+            PosHeaderEnd = InStr(rtf, sTestString)
+        End If
+        
+        rtf = mid(rtf, PosHeaderEnd + Len(sTestString))
+        
+        rtf = "{\rtf1\ansi\ansicpg1252 \deff0{\fonttbl" & vbCrLf & _
+                "{\f0\fswiss\fcharset0 Courier New;}}" & vbCrLf & _
+                "{\colortbl\red0\green0\blue0;\red106\green44\blue44;\red44\green106\blue44;\red44\green44\blue106;}" & vbCrLf & _
+                rtf
+                
+        lines = Split(rtf, vbCrLf)
+        Dim s As String
+        For i = LBound(lines) To UBound(lines)
+            n = QuoteFixMacro.CalcNesting(lines(i)).level
+            If (n = 0) Then
+                resRTF = resRTF & lines(i) & vbCrLf
+            Else
+                If (Right(lines(i), 4) = "\par") Then
+                    s = Left(lines(i), Len(lines(i)) - Len("\par"))
+                    resRTF = resRTF & "\cf" & n Mod NUM_RTF_COLORS & " " & s & "\cf0  " & "\par" & vbCrLf
+                Else
+                    resRTF = resRTF & "\cf" & n Mod NUM_RTF_COLORS & " " & lines(i) & "\cf0  " & vbCrLf
+                End If
+            End If
+        Next i
+    Else
+        Debug.Print "error while reading rtf! " & ret
+        ColorizeMailItem = ""
+        Exit Function
+    End If
+    
+    'remove some rtf commands
+    resRTF = Replace(resRTF, "\viewkind4\uc1", "")
+    resRTF = Replace(resRTF, "\uc1", "")
+    'VERY IMPORTANT, outlook will change the message back to PlainText otherwise!!!
+    resRTF = Replace(resRTF, "\fromtext", "")
+    Debug.Print resRTF
+    
+       
+    'write RTF back to form
+    ret = WriteRTF(Session.CurrentProfileName, MyMailItem.EntryID, folder.StoreID, resRTF)
+    If (ret = 0) Then
+        Debug.Print "rtf write okay"
+    Else
+        Debug.Print "rtf write FAILURE"
+        ColorizeMailItem = ""
+        Exit Function
+    End If
+    
+    
+    'dereference all objects! otherwise, rtf isn't going to be updated!
+    Set folder = Nothing
+    'save return value
+    ColorizeMailItem = MyMailItem.EntryID
+    Set MyMailItem = Nothing
+End Function
+
+
+Public Sub DisplayMailItemByID(id As String)
+    Dim it As MailItem
+    Set it = Session.GetItemFromID(id, Session.GetDefaultFolder(olFolderInbox).StoreID)
+    it.Display
+    Set it = Nothing
+End Sub

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-07-04 09:45:47 UTC (rev 101)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-07-04 09:50:35 UTC (rev 102)
@@ -97,6 +97,9 @@
 '  * Applied patch 3296731 by Matej Mihelic - Replaced hardcoded call to "MAPI"
 '  * Added LoadConfiguration() so you can store personal settings in the registry. These won\xB4t get lost when updating the macro
 
+'$Revision$ - not released
+'  * <no changes until now>
+'
 'Ideas were taken from
 '  * Daniele Bochicchio
 '    Button integration and sample code - http://lab.aspitalia.com/35/Outlook-2007-2003-Reply-With-Quoting-Macro.aspx


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[101] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2011-07-04 09:45:53

Revision: 101
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=101&view=rev
Author:   olly98
Date:     2011-07-04 09:45:47 +0000 (Mon, 04 Jul 2011)

Log Message:
-----------
preparing release 1.4

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-06-01 13:59:14 UTC (rev 100)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-07-04 09:45:47 UTC (rev 101)
@@ -87,7 +87,7 @@
 ' * renamed "fromName" to "senderName" in order to reflect real content of the variable
 ' * fixed cursor position in the case of absence of "%C", but presence of "%Q"
 '
-'$Revision$ - not released
+'Version 1.4 - 2011-07-04
 '  * Added CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS, which condenses quoted outlook headers
 '    The format of the condensed header is configured at CONDENSED_HEADER_FORMAT
 '  * Added CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[100] quotefixmacro/trunk/QuoteFixMacro.bas

From: <lar...@us...> - 2011-06-01 13:59:22

Revision: 100
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=100&view=rev
Author:   larsen255
Date:     2011-06-01 13:59:14 +0000 (Wed, 01 Jun 2011)

Log Message:
-----------
fixed overflow

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-05-19 11:19:36 UTC (rev 99)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-06-01 13:59:14 UTC (rev 100)
@@ -515,7 +515,7 @@
     Dim curLine As String
     Dim rows() As String
     Dim lastPrefix As String
-    Dim i As Integer
+    Dim i As Long
     Dim curNesting As NestingType
     Dim nextNesting As NestingType
 


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[99] quotefixmacro/trunk/QuoteFixMacro.bas

From: <lar...@us...> - 2011-05-19 11:19:42

Revision: 99
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=99&view=rev
Author:   larsen255
Date:     2011-05-19 11:19:36 +0000 (Thu, 19 May 2011)

Log Message:
-----------
added missing type declarations

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-05-19 09:53:25 UTC (rev 98)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-05-19 11:19:36 UTC (rev 99)
@@ -134,7 +134,7 @@
 '--------------------------------------------------------
 '*** Feature QuoteColorizer ***
 '--------------------------------------------------------
-Private Const DEFAULT_USE_COLORIZER = False
+Private Const DEFAULT_USE_COLORIZER As Boolean = False
 'If you enable it, you need MAPIRTF.DLL in C:\Windows\System32
 'Does NOT work at Windows 7/64bit Outlook 2010/32bit
 '
@@ -206,7 +206,7 @@
 '----- END OF DEFAULT CONFIGURATION -----------------------------------------------------------------------------------
 
 
-Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----"
+Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE As String = "-----"
 'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Urspr\xFCngliche Nachricht-----"
 'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Original Message-----"
 Private Const OUTLOOK_ORIGINALMESSAGE   As String = "> " & OUTLOOK_PLAIN_ORIGINALMESSAGE


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[98] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2011-05-19 09:53:31

Revision: 98
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=98&view=rev
Author:   olly98
Date:     2011-05-19 09:53:25 +0000 (Thu, 19 May 2011)

Log Message:
-----------
default configuration now done in the header of the macro again - and not in the body
added sub to store default configuration in the registry 

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-05-18 13:33:18 UTC (rev 97)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-05-19 09:53:25 UTC (rev 98)
@@ -115,20 +115,33 @@
 Option Explicit
 
 
-'----- CONFIGURATION ------------------------------------------------------------------------------------------
-'The default configuration values are set in LoadConfiguration()
+'----- DEFAULT CONFIGURATION ------------------------------------------------------------------------------------------
+'The configuration is now stored in the registry
+'Below, the DEFAULT values are provided
+'
+'The macro NEVER stores entries in the registry by itself
+'
+'You can store the default configuration in the registry by executing
+'  StoreDefaultConfiguration()
+'or by writing a routing executing commands similar to the following:
+'   Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONVERT_TO_PLAIN", "true")
+'Finally, or by manually creating entries in this registry hive:
+'    HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro
+Private Const APPNAME As String = "QuoteFixMacro"
+Private Const REG_GROUP_CONFIG As String = "Config"
 
+
 '--------------------------------------------------------
 '*** Feature QuoteColorizer ***
 '--------------------------------------------------------
-Private USE_COLORIZER As Boolean
+Private Const DEFAULT_USE_COLORIZER = False
 'If you enable it, you need MAPIRTF.DLL in C:\Windows\System32
 'Does NOT work at Windows 7/64bit Outlook 2010/32bit
 '
 'Please enable convert RTF-to-Text at sending. Otherwise, the recipients will always receive HTML E-Mails
 
 'How many different colors should be used for colorizing the quotes?
-Private NUM_RTF_COLORS As Integer
+Private Const DEFAULT_NUM_RTF_COLORS As Integer = 4
 
 
 '--------------------------------------------------------
@@ -139,37 +152,41 @@
 'after N charaters. Outlook wraps text automatically after sending it,
 'but doesn't display the wrap when editing
 'you can edit the auto wrap setting at "Tools / Options / Email Format / Internet Format"
-Private USE_SOFTWRAP As Boolean
+Private Const DEFAULT_USE_SOFTWRAP As Boolean = False
 
 'put as much characters as set in Outlook at "Tools / Options / Email Format / Internet Format"
-Private SEVENTY_SIX_CHARS As String
+Private Const DEFAULT_SEVENTY_SIX_CHARS As String = "123456789x123456789x123456789x123456789x123456789x123456789x123456789x123456"
 
 'This constant has to be adapted to fit your needs (incoprating the used font, display size, ...)
-Private PIXEL_PER_CHARACTER As Double
+Private Const DEFAULT_PIXEL_PER_CHARACTER As Double = 8.61842105263158
 
 
 '--------------------------------------------------------
 '*** Configuration constants ***
 '--------------------------------------------------------
 'If <> -1, strip quotes with level > INCLUDE_QUOTES_TO_LEVEL
-Private INCLUDE_QUOTES_TO_LEVEL As Integer
+Private Const DEFAULT_INCLUDE_QUOTES_TO_LEVEL As Integer = -1
 
 'At which column should the text be wrapped?
-Private LINE_WRAP_AFTER As Integer
+Private Const DEFAULT_LINE_WRAP_AFTER As Integer = 75
 
-Private DATE_FORMAT As String
+Private Const DEFAULT_DATE_FORMAT As String = "yyyy-mm-dd"
+'alternative date format
+'Private Const DEFAULT_DATE_FORMAT As String = "ddd, d MMM yyyy at HH:mm:ss"
 
 'Strip the sender\xB4s signature?
-Private STRIP_SIGNATURE As Boolean
+Private Const DEFAULT_STRIP_SIGNATURE As Boolean = True
 
 'Automatically convert HTML/RTF-Mails to plain text?
-Private CONVERT_TO_PLAIN As Boolean
+Private Const DEFAULT_CONVERT_TO_PLAIN As Boolean = False
 
 'Enable QUOTING_TEMPLATE
-Private USE_QUOTING_TEMPLATE As Boolean
+Private Const DEFAULT_USE_QUOTING_TEMPLATE As Boolean = False
 
 'If the constant USE_QUOTING_TEMPLATE is set, this template is used instead of the signature
-Private QUOTING_TEMPLATE As String
+Private Const DEFAULT_QUOTING_TEMPLATE As String = _
+"%SN wrote on %D:" & vbCr & _
+"%Q"
 
 
 '--------------------------------------------------------
@@ -177,22 +194,18 @@
 '--------------------------------------------------------
 
 'Condense embedded quoted Outlook headers?
-Private CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS As Boolean
+Private Const DEFAULT_CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS As Boolean = True
 
 'Should the first header also be condensed?
 'In case you use a custom header, (e.g., "You wrote on %D:", this should be set to false)
-Private CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER As Boolean
+Private Const DEFAULT_CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER As Boolean = False
 
 'Format of condensed header
-Private CONDENSED_HEADER_FORMAT As String
+Private Const DEFAULT_CONDENSED_HEADER_FORMAT As String = "%SN wrote on %D:"
 
-'----- END OF CONFIGURATION -----------------------------------------------------------------------------------
+'----- END OF DEFAULT CONFIGURATION -----------------------------------------------------------------------------------
 
 
-
-Private Const APPNAME As String = "QuoteFixMacro"
-Private Const REG_GROUP_CONFIG As String = "Config"
-
 Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----"
 'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Urspr\xFCngliche Nachricht-----"
 'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Original Message-----"
@@ -209,6 +222,25 @@
 Private Const PATTERN_OUTLOOK_HEADER    As String = "%OH"
 
 
+'Variables storing the configuration
+'They are set in LoadConfiguration()
+Private USE_COLORIZER As Boolean
+Private NUM_RTF_COLORS As Integer
+Private USE_SOFTWRAP As Boolean
+Private SEVENTY_SIX_CHARS As String
+Private PIXEL_PER_CHARACTER As Double
+Private INCLUDE_QUOTES_TO_LEVEL As Integer
+Private LINE_WRAP_AFTER As Integer
+Private DATE_FORMAT As String
+Private STRIP_SIGNATURE As Boolean
+Private CONVERT_TO_PLAIN As Boolean
+Private USE_QUOTING_TEMPLATE As Boolean
+Private QUOTING_TEMPLATE As String
+Private CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS As Boolean
+Private CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER As Boolean
+Private CONDENSED_HEADER_FORMAT As String
+
+
 'For QuoteColorizer
 Public Declare Function WriteRTF _
         Lib "mapirtf.dll" _
@@ -329,35 +361,42 @@
     CalcNesting = res
 End Function
 
+'Stores the default values in the system registry
+Public Sub StoreDefaultConfiguration()
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "USE_COLORIZER", DEFAULT_USE_COLORIZER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "NUM_RTF_COLORS", DEFAULT_NUM_RTF_COLORS)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "USE_SOFTWRAP", DEFAULT_USE_SOFTWRAP)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "SEVENTY_SIX_CHARS", DEFAULT_SEVENTY_SIX_CHARS)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "PIXEL_PER_CHARACTER", DEFAULT_PIXEL_PER_CHARACTER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "INCLUDE_QUOTES_TO_LEVEL", DEFAULT_INCLUDE_QUOTES_TO_LEVEL)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "LINE_WRAP_AFTER", DEFAULT_LINE_WRAP_AFTER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "DATE_FORMAT", DEFAULT_DATE_FORMAT)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "STRIP_SIGNATURE", DEFAULT_STRIP_SIGNATURE)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONVERT_TO_PLAIN", DEFAULT_CONVERT_TO_PLAIN)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "USE_QUOTING_TEMPLATE", DEFAULT_USE_QUOTING_TEMPLATE)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "QUOTING_TEMPLATE", DEFAULT_QUOTING_TEMPLATE)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS", DEFAULT_CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER", DEFAULT_CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER)
+    Call SaveSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSED_HEADER_FORMAT", DEFAULT_CONDENSED_HEADER_FORMAT)
+End Sub
+
 'Loads the personal settings from the registry.
-'
-'You can store options by executing commands like this:
-'    Call SaveSetting(APPNAME, "Config", "CONVERT_TO_PLAIN", "true")
-
-'or by manually creating entries in this registry hive:
-'    HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro
-'
 Private Sub LoadConfiguration()
-
-    USE_COLORIZER = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_COLORIZER", False))
-    NUM_RTF_COLORS = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "NUM_RTF_COLORS", 4))
-    USE_SOFTWRAP = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_SOFTWRAP", False))
-    SEVENTY_SIX_CHARS = GetSetting(APPNAME, REG_GROUP_CONFIG, "SEVENTY_SIX_CHARS", "123456789x123456789x123456789x123456789x123456789x123456789x123456789x123456")
-    PIXEL_PER_CHARACTER = CDbl(GetSetting(APPNAME, REG_GROUP_CONFIG, "PIXEL_PER_CHARACTER", 8.61842105263158))
-    INCLUDE_QUOTES_TO_LEVEL = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "INCLUDE_QUOTES_TO_LEVEL", -1))
-    LINE_WRAP_AFTER = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "LINE_WRAP_AFTER", 75))
-    
-    DATE_FORMAT = GetSetting(APPNAME, REG_GROUP_CONFIG, "DATE_FORMAT", "yyyy-mm-dd")
-    'alternative date format: "ddd, d MMM yyyy at HH:mm:ss"
-    
-    STRIP_SIGNATURE = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "STRIP_SIGNATURE", True))
-    CONVERT_TO_PLAIN = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONVERT_TO_PLAIN", False))
-    USE_QUOTING_TEMPLATE = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_QUOTING_TEMPLATE", False))
-    QUOTING_TEMPLATE = GetSetting(APPNAME, REG_GROUP_CONFIG, "QUOTING_TEMPLATE", "%SN wrote on %D:" & vbCr & "%Q")
-    CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS", True))
-    CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER", False))
-    CONDENSED_HEADER_FORMAT = GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSED_HEADER_FORMAT", "%SN wrote on %D:")
-
+    USE_COLORIZER = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_COLORIZER", DEFAULT_USE_COLORIZER))
+    NUM_RTF_COLORS = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "NUM_RTF_COLORS", DEFAULT_NUM_RTF_COLORS))
+    USE_SOFTWRAP = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_SOFTWRAP", DEFAULT_USE_SOFTWRAP))
+    SEVENTY_SIX_CHARS = GetSetting(APPNAME, REG_GROUP_CONFIG, "SEVENTY_SIX_CHARS", DEFAULT_SEVENTY_SIX_CHARS)
+    PIXEL_PER_CHARACTER = CDbl(GetSetting(APPNAME, REG_GROUP_CONFIG, "PIXEL_PER_CHARACTER", DEFAULT_PIXEL_PER_CHARACTER))
+    INCLUDE_QUOTES_TO_LEVEL = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "INCLUDE_QUOTES_TO_LEVEL", DEFAULT_INCLUDE_QUOTES_TO_LEVEL))
+    LINE_WRAP_AFTER = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "LINE_WRAP_AFTER", DEFAULT_LINE_WRAP_AFTER))
+    DATE_FORMAT = GetSetting(APPNAME, REG_GROUP_CONFIG, "DATE_FORMAT", DEFAULT_DATE_FORMAT)
+    STRIP_SIGNATURE = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "STRIP_SIGNATURE", DEFAULT_STRIP_SIGNATURE))
+    CONVERT_TO_PLAIN = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONVERT_TO_PLAIN", DEFAULT_CONVERT_TO_PLAIN))
+    USE_QUOTING_TEMPLATE = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_QUOTING_TEMPLATE", DEFAULT_USE_QUOTING_TEMPLATE))
+    QUOTING_TEMPLATE = GetSetting(APPNAME, REG_GROUP_CONFIG, "QUOTING_TEMPLATE", DEFAULT_QUOTING_TEMPLATE)
+    CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS", DEFAULT_CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS))
+    CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER", DEFAULT_CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER))
+    CONDENSED_HEADER_FORMAT = GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSED_HEADER_FORMAT", DEFAULT_CONDENSED_HEADER_FORMAT)
 End Sub
 
 'Description:
@@ -1259,5 +1298,3 @@
     it.Display
     Set it = Nothing
 End Sub
-
-


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[97] quotefixmacro/trunk/QuoteFixMacro.bas

From: <lar...@us...> - 2011-05-18 13:33:28

Revision: 97
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=97&view=rev
Author:   larsen255
Date:     2011-05-18 13:33:18 +0000 (Wed, 18 May 2011)

Log Message:
-----------
Former configuration constants are now set via a function that reads values from the registry. If there are none, the default values are used.

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-05-03 09:34:09 UTC (rev 96)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-05-18 13:33:18 UTC (rev 97)
@@ -95,6 +95,7 @@
 '  * Added support for custom template configured in the macro (QUOTING_TEMPLATE) - this can be used instead of the signature configuration
 '  * Merged SoftWrap and QuoteColorizerMacro into QuoteFixMacro.bas
 '  * Applied patch 3296731 by Matej Mihelic - Replaced hardcoded call to "MAPI"
+'  * Added LoadConfiguration() so you can store personal settings in the registry. These won\xB4t get lost when updating the macro
 
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -113,17 +114,21 @@
 
 Option Explicit
 
+
+'----- CONFIGURATION ------------------------------------------------------------------------------------------
+'The default configuration values are set in LoadConfiguration()
+
 '--------------------------------------------------------
 '*** Feature QuoteColorizer ***
 '--------------------------------------------------------
-Private Const USE_COLORIZER = False
+Private USE_COLORIZER As Boolean
 'If you enable it, you need MAPIRTF.DLL in C:\Windows\System32
 'Does NOT work at Windows 7/64bit Outlook 2010/32bit
 '
 'Please enable convert RTF-to-Text at sending. Otherwise, the recipients will always receive HTML E-Mails
 
 'How many different colors should be used for colorizing the quotes?
-Private Const NUM_RTF_COLORS As Integer = 4
+Private NUM_RTF_COLORS As Integer
 
 
 '--------------------------------------------------------
@@ -134,41 +139,37 @@
 'after N charaters. Outlook wraps text automatically after sending it,
 'but doesn't display the wrap when editing
 'you can edit the auto wrap setting at "Tools / Options / Email Format / Internet Format"
-Private Const USE_SOFTWRAP = False
+Private USE_SOFTWRAP As Boolean
 
 'put as much characters as set in Outlook at "Tools / Options / Email Format / Internet Format"
-Private Const SEVENTY_SIX_CHARS As String = "123456789x123456789x123456789x123456789x123456789x123456789x123456789x123456"
+Private SEVENTY_SIX_CHARS As String
 
 'This constant has to be adapted to fit your needs (incoprating the used font, display size, ...)
-Private Const PIXEL_PER_CHARACTER As Double = 8.61842105263158
+Private PIXEL_PER_CHARACTER As Double
 
 
 '--------------------------------------------------------
 '*** Configuration constants ***
 '--------------------------------------------------------
 'If <> -1, strip quotes with level > INCLUDE_QUOTES_TO_LEVEL
-Private Const INCLUDE_QUOTES_TO_LEVEL As Integer = -1
+Private INCLUDE_QUOTES_TO_LEVEL As Integer
 
 'At which column should the text be wrapped?
-Public Const LINE_WRAP_AFTER As Integer = 75
+Private LINE_WRAP_AFTER As Integer
 
-Private Const DATE_FORMAT As String = "yyyy-mm-dd"
-'alternative date format
-'Private Const DATE_FORMAT As String = "ddd, d MMM yyyy at HH:mm:ss"
+Private DATE_FORMAT As String
 
 'Strip the sender\xB4s signature?
-Private Const STRIP_SIGNATURE As Boolean = True
+Private STRIP_SIGNATURE As Boolean
 
 'Automatically convert HTML/RTF-Mails to plain text?
-Private Const CONVERT_TO_PLAIN As Boolean = False
+Private CONVERT_TO_PLAIN As Boolean
 
 'Enable QUOTING_TEMPLATE
-Private Const USE_QUOTING_TEMPLATE As Boolean = False
+Private USE_QUOTING_TEMPLATE As Boolean
 
 'If the constant USE_QUOTING_TEMPLATE is set, this template is used instead of the signature
-Private Const QUOTING_TEMPLATE As String = _
-"%SN wrote on %D:" & vbCr & _
-"%Q"
+Private QUOTING_TEMPLATE As String
 
 
 '--------------------------------------------------------
@@ -176,18 +177,22 @@
 '--------------------------------------------------------
 
 'Condense embedded quoted Outlook headers?
-Private Const CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = True
+Private CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS As Boolean
 
 'Should the first header also be condensed?
 'In case you use a custom header, (e.g., "You wrote on %D:", this should be set to false)
-Private Const CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = False
+Private CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER As Boolean
 
 'Format of condensed header
-Private Const CONDENSED_HEADER_FORMAT = "%SN wrote on %D:"
+Private CONDENSED_HEADER_FORMAT As String
 
-'--------------------------------------------------------
+'----- END OF CONFIGURATION -----------------------------------------------------------------------------------
 
 
+
+Private Const APPNAME As String = "QuoteFixMacro"
+Private Const REG_GROUP_CONFIG As String = "Config"
+
 Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----"
 'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Urspr\xFCngliche Nachricht-----"
 'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Original Message-----"
@@ -324,6 +329,37 @@
     CalcNesting = res
 End Function
 
+'Loads the personal settings from the registry.
+'
+'You can store options by executing commands like this:
+'    Call SaveSetting(APPNAME, "Config", "CONVERT_TO_PLAIN", "true")
+
+'or by manually creating entries in this registry hive:
+'    HKEY_CURRENT_USER\Software\VB and VBA Program Settings\QuoteFixMacro
+'
+Private Sub LoadConfiguration()
+
+    USE_COLORIZER = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_COLORIZER", False))
+    NUM_RTF_COLORS = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "NUM_RTF_COLORS", 4))
+    USE_SOFTWRAP = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_SOFTWRAP", False))
+    SEVENTY_SIX_CHARS = GetSetting(APPNAME, REG_GROUP_CONFIG, "SEVENTY_SIX_CHARS", "123456789x123456789x123456789x123456789x123456789x123456789x123456789x123456")
+    PIXEL_PER_CHARACTER = CDbl(GetSetting(APPNAME, REG_GROUP_CONFIG, "PIXEL_PER_CHARACTER", 8.61842105263158))
+    INCLUDE_QUOTES_TO_LEVEL = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "INCLUDE_QUOTES_TO_LEVEL", -1))
+    LINE_WRAP_AFTER = Val(GetSetting(APPNAME, REG_GROUP_CONFIG, "LINE_WRAP_AFTER", 75))
+    
+    DATE_FORMAT = GetSetting(APPNAME, REG_GROUP_CONFIG, "DATE_FORMAT", "yyyy-mm-dd")
+    'alternative date format: "ddd, d MMM yyyy at HH:mm:ss"
+    
+    STRIP_SIGNATURE = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "STRIP_SIGNATURE", True))
+    CONVERT_TO_PLAIN = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONVERT_TO_PLAIN", False))
+    USE_QUOTING_TEMPLATE = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "USE_QUOTING_TEMPLATE", False))
+    QUOTING_TEMPLATE = GetSetting(APPNAME, REG_GROUP_CONFIG, "QUOTING_TEMPLATE", "%SN wrote on %D:" & vbCr & "%Q")
+    CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS", True))
+    CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = CBool(GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER", False))
+    CONDENSED_HEADER_FORMAT = GetSetting(APPNAME, REG_GROUP_CONFIG, "CONDENSED_HEADER_FORMAT", "%SN wrote on %D:")
+
+End Sub
+
 'Description:
 '   Strips away ">" and " " at the beginning to have the plain text
 Private Function StripLine(line As String) As String
@@ -658,6 +694,10 @@
 Private Sub FixMailText(SelectedObject As Object, MailMode As ReplyType)
     Dim TempObj As Object
     
+    
+    Call LoadConfiguration
+   
+    
     'we only understand mail items, no PostItems, NoteItems, ...
     If Not (TypeName(SelectedObject) = "MailItem") Then
         On Error GoTo catch:   'try, catch replacement


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[96] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2011-05-03 09:34:16

Revision: 96
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=96&view=rev
Author:   olly98
Date:     2011-05-03 09:34:09 +0000 (Tue, 03 May 2011)

Log Message:
-----------
applied patch 3296731

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-30 15:31:53 UTC (rev 95)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-05-03 09:34:09 UTC (rev 96)
@@ -94,6 +94,7 @@
 '  * Fixed compile time constants to work with Outlook 2007 and 2010
 '  * Added support for custom template configured in the macro (QUOTING_TEMPLATE) - this can be used instead of the signature configuration
 '  * Merged SoftWrap and QuoteColorizerMacro into QuoteFixMacro.bas
+'  * Applied patch 3296731 by Matej Mihelic - Replaced hardcoded call to "MAPI"
 
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -1134,7 +1135,7 @@
     Set folder = Session.GetDefaultFolder(olFolderInbox)
     
     rtf = Space(99999)  'init rtf to max length of message!
-    ret = ReadRTF("MAPI", MyMailItem.EntryID, folder.StoreID, rtf)
+    ret = ReadRTF(Session.CurrentProfileName, MyMailItem.EntryID, folder.StoreID, rtf)
     If (ret = 0) Then
         'ole call success!!!
         rtf = Trim(rtf)  'kill unnecessary spaces (from rtf var init with Space(rtf))
@@ -1194,7 +1195,7 @@
     
        
     'write RTF back to form
-    ret = WriteRTF("MAPI", MyMailItem.EntryID, folder.StoreID, resRTF)
+    ret = WriteRTF(Session.CurrentProfileName, MyMailItem.EntryID, folder.StoreID, resRTF)
     If (ret = 0) Then
         Debug.Print "rtf write okay"
     Else


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[95] quotefixmacro/trunk

From: <ol...@us...> - 2011-04-30 15:32:00

Revision: 95
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=95&view=rev
Author:   olly98
Date:     2011-04-30 15:31:53 +0000 (Sat, 30 Apr 2011)

Log Message:
-----------
merged QuoteColorizerMacro into QuoteFixMacro

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Removed Paths:
-------------
    quotefixmacro/trunk/QuoteColorizerMacro.bas

Deleted: quotefixmacro/trunk/QuoteColorizerMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteColorizerMacro.bas	2011-04-30 15:13:53 UTC (rev 94)
+++ quotefixmacro/trunk/QuoteColorizerMacro.bas	2011-04-30 15:31:53 UTC (rev 95)
@@ -1,164 +0,0 @@
-Attribute VB_Name = "QuoteColorizerMacro"
-'$Id$
-'
-'Quote Colorizer Macro TRUNK
-'
-'Quote Colorizer Macro is part of the macros4outlook project
-'see http://sourceforge.net/apps/mediawiki/macros4outlook/index.php?title=Quote_Colorizer_Macro or
-'    http://sourceforge.net/projects/macros4outlook/ for more information
-'
-'For more information on Outlook see http://www.microsoft.com/outlook
-'Outlook is (C) by Microsoft
-
-'****************************************************************************
-'License:
-'
-'QuoteColorizerMacro
-'  copyright 2006-2009 Daniel Martin. All rights reserved.
-'
-'
-'Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
-'
-'   1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
-'   2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
-'   3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission.
-'
-'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-'****************************************************************************
-
-'Changelog
-'
-'Version 1.0 - 2011-04-22
-' * first public relese
-'
-'$Revision$ - not released
-
-Option Explicit
-
-
-Public Declare Function WriteRTF _
-        Lib "mapirtf.dll" _
-        Alias "writertf" (ByVal ProfileName As String, _
-                          ByVal MessageID As String, _
-                          ByVal StoreID As String, _
-                          ByVal cText As String) _
-        As Integer
-
-Public Declare Function ReadRTF _
-        Lib "mapirtf.dll" _
-        Alias "readrtf" (ByVal ProfileName As String, _
-                         ByVal SrcMsgID As String, _
-                         ByVal SrcStoreID As String, _
-                         ByRef MsgRTF As String) _
-        As Integer
-
-
-Private Const NUM_RTF_COLORS As Integer = 4
-
-Private Const ENABLE_MACRO As Boolean = True
-
-
-Public Function ColorizeMailItem(MyMailItem As MailItem) As String
-    Dim folder As MAPIFolder
-    Dim rtf  As String, lines() As String, resRTF As String
-    Dim i As Integer, n As Integer, ret As Integer
-  
-    
-    'save the mailitem to get an entry id, then forget reference to that rtf gets commited.
-    'display mailitem by id later on.
-    If ((Not MyMailItem.BodyFormat = olFormatPlain) Or (ENABLE_MACRO = False)) Then 'we just understand Plain Mails
-        ColorizeMailItem = ""
-        Exit Function
-    End If
-       
-    'richt text it
-    MyMailItem.BodyFormat = olFormatRichText
-    MyMailItem.Save  'need to save to be able to access rtf via EntryID (.save creates ExtryID if not saved before)!
-        
-    Set folder = Session.GetDefaultFolder(olFolderInbox)
-    
-    rtf = Space(99999)  'init rtf to max length of message!
-    ret = ReadRTF("MAPI", MyMailItem.EntryID, folder.StoreID, rtf)
-    If (ret = 0) Then
-        'ole call success!!!
-        rtf = Trim(rtf)  'kill unnecessary spaces (from rtf var init with Space(rtf))
-        Debug.Print rtf & vbCrLf & "*************************************************************" & vbCrLf
-        
-        'we have our own rtf haeder, remove generated one
-        Dim PosHeaderEnd As Integer
-        Dim sTestString As String
-        PosHeaderEnd = InStr(rtf, "\uc1\pard\plain\deftab360")
-        If (PosHeaderEnd = 0) Then
-            sTestString = "\uc1\pard\f0\fs20\lang1031"
-            PosHeaderEnd = InStr(rtf, sTestString)
-        End If
-        If (PosHeaderEnd = 0) Then
-            sTestString = "\viewkind4\uc1\pard\f0\fs20"
-            PosHeaderEnd = InStr(rtf, sTestString)
-        End If
-        If (PosHeaderEnd = 0) Then
-            sTestString = "\pard\f0\fs20\lang1031"
-            PosHeaderEnd = InStr(rtf, sTestString)
-        End If
-        
-        rtf = mid(rtf, PosHeaderEnd + Len(sTestString))
-        
-        rtf = "{\rtf1\ansi\ansicpg1252 \deff0{\fonttbl" & vbCrLf & _
-                "{\f0\fswiss\fcharset0 Courier New;}}" & vbCrLf & _
-                "{\colortbl\red0\green0\blue0;\red106\green44\blue44;\red44\green106\blue44;\red44\green44\blue106;}" & vbCrLf & _
-                rtf
-                
-        lines = Split(rtf, vbCrLf)
-        Dim s As String
-        For i = LBound(lines) To UBound(lines)
-            n = QuoteFixMacro.CalcNesting(lines(i)).level
-            If (n = 0) Then
-                resRTF = resRTF & lines(i) & vbCrLf
-            Else
-                If (Right(lines(i), 4) = "\par") Then
-                    s = Left(lines(i), Len(lines(i)) - Len("\par"))
-                    resRTF = resRTF & "\cf" & n Mod NUM_RTF_COLORS & " " & s & "\cf0  " & "\par" & vbCrLf
-                Else
-                    resRTF = resRTF & "\cf" & n Mod NUM_RTF_COLORS & " " & lines(i) & "\cf0  " & vbCrLf
-                End If
-            End If
-        Next i
-    Else
-        Debug.Print "error while reading rtf! " & ret
-        ColorizeMailItem = ""
-        Exit Function
-    End If
-    
-    'remove some rtf commands
-    resRTF = Replace(resRTF, "\viewkind4\uc1", "")
-    resRTF = Replace(resRTF, "\uc1", "")
-    'VERY IMPORTANT, outlook will change the message back to PlainText otherwise!!!
-    resRTF = Replace(resRTF, "\fromtext", "")
-    Debug.Print resRTF
-    
-       
-    'write RTF back to form
-    ret = WriteRTF("MAPI", MyMailItem.EntryID, folder.StoreID, resRTF)
-    If (ret = 0) Then
-        Debug.Print "rtf write okay"
-    Else
-        Debug.Print "rtf write FAILURE"
-        ColorizeMailItem = ""
-        Exit Function
-    End If
-    
-    
-    'dereference all objects! otherwise, rtf isn't going to be updated!
-    Set folder = Nothing
-    'save return value
-    ColorizeMailItem = MyMailItem.EntryID
-    Set MyMailItem = Nothing
-End Function
-
-
-Public Sub DisplayMailItemByID(id As String)
-    Dim it As MailItem
-    Set it = Session.GetItemFromID(id, Session.GetDefaultFolder(olFolderInbox).StoreID)
-    it.Display
-    Set it = Nothing
-End Sub

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-30 15:13:53 UTC (rev 94)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-30 15:31:53 UTC (rev 95)
@@ -93,7 +93,7 @@
 '  * Added CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER
 '  * Fixed compile time constants to work with Outlook 2007 and 2010
 '  * Added support for custom template configured in the macro (QUOTING_TEMPLATE) - this can be used instead of the signature configuration
-'  * Merged SoftWrap into QuoteFixMacro.bas
+'  * Merged SoftWrap and QuoteColorizerMacro into QuoteFixMacro.bas
 
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -113,20 +113,20 @@
 Option Explicit
 
 '--------------------------------------------------------
-'*** Constants for conditional compiling ***
+'*** Feature QuoteColorizer ***
+'--------------------------------------------------------
+Private Const USE_COLORIZER = False
+'If you enable it, you need MAPIRTF.DLL in C:\Windows\System32
+'Does NOT work at Windows 7/64bit Outlook 2010/32bit
 '
-'Enter these constants in the VBA project properties. The lines here only document the
-'available constants.
-'--------------------------------------------------------
+'Please enable convert RTF-to-Text at sending. Otherwise, the recipients will always receive HTML E-Mails
 
-'Should mails be colorized? (needs QuoteColorizerMacro.bas)
-'(Different configuration formats for Outlook 2010 and older outlooks. Please choose the right variant)
-'#Const USE_COLORIZER = True 'Outlook 2010
-'USE_COLORIZER = -1 'Outlook 2003 and 2007
+'How many different colors should be used for colorizing the quotes?
+Private Const NUM_RTF_COLORS As Integer = 4
 
 
 '--------------------------------------------------------
-'*** Feature configuration ***
+'*** Feature SoftWrap ***
 '--------------------------------------------------------
 'Enable SoftWrap
 'resize window so that the text editor wraps the text automatically
@@ -202,6 +202,26 @@
 Private Const PATTERN_SENT_DATE         As String = "%D"
 Private Const PATTERN_OUTLOOK_HEADER    As String = "%OH"
 
+
+'For QuoteColorizer
+Public Declare Function WriteRTF _
+        Lib "mapirtf.dll" _
+        Alias "writertf" (ByVal ProfileName As String, _
+                          ByVal MessageID As String, _
+                          ByVal StoreID As String, _
+                          ByVal cText As String) _
+        As Integer
+
+'For QuoteColorizer
+Public Declare Function ReadRTF _
+        Lib "mapirtf.dll" _
+        Alias "readrtf" (ByVal ProfileName As String, _
+                         ByVal SrcMsgID As String, _
+                         ByVal SrcStoreID As String, _
+                         ByRef MsgRTF As String) _
+        As Integer
+
+
 Private Enum ReplyType
     TypeReply = 1
     TypeReplyAll = 2
@@ -811,19 +831,19 @@
     NewMail.Body = MySignature
     
     'Extensions, in case Colorize is activated
-    #If USE_COLORIZER Then
+    If USE_COLORIZER Then
         Dim mailID As String
-        mailID = QuoteColorizerMacro.ColorizeMailItem(NewMail)
+        mailID = ColorizeMailItem(NewMail)
         If (Trim("" & mailID) <> "") Then  'no error occured or quotefix macro not there...
-            Call QuoteColorizerMacro.DisplayMailItemByID(mailID)
+            Call DisplayMailItemByID(mailID)
         Else
             'Display window
             NewMail.Display
         End If
-    #Else
+    Else
         'Display window
         NewMail.Display
-    #End If
+    End If
 
     'jump to the right place
     Dim i As Integer
@@ -1092,3 +1112,111 @@
         Application.ActiveInspector.Width = (LINE_WRAP_AFTER + 2) * PIXEL_PER_CHARACTER
     End If
 End Sub
+
+
+Public Function ColorizeMailItem(MyMailItem As MailItem) As String
+    Dim folder As MAPIFolder
+    Dim rtf  As String, lines() As String, resRTF As String
+    Dim i As Integer, n As Integer, ret As Integer
+  
+    
+    'save the mailitem to get an entry id, then forget reference to that rtf gets commited.
+    'display mailitem by id later on.
+    If ((Not MyMailItem.BodyFormat = olFormatPlain)) Then 'we just understand Plain Mails
+        ColorizeMailItem = ""
+        Exit Function
+    End If
+       
+    'richt text it
+    MyMailItem.BodyFormat = olFormatRichText
+    MyMailItem.Save  'need to save to be able to access rtf via EntryID (.save creates ExtryID if not saved before)!
+        
+    Set folder = Session.GetDefaultFolder(olFolderInbox)
+    
+    rtf = Space(99999)  'init rtf to max length of message!
+    ret = ReadRTF("MAPI", MyMailItem.EntryID, folder.StoreID, rtf)
+    If (ret = 0) Then
+        'ole call success!!!
+        rtf = Trim(rtf)  'kill unnecessary spaces (from rtf var init with Space(rtf))
+        Debug.Print rtf & vbCrLf & "*************************************************************" & vbCrLf
+        
+        'we have our own rtf haeder, remove generated one
+        Dim PosHeaderEnd As Integer
+        Dim sTestString As String
+        PosHeaderEnd = InStr(rtf, "\uc1\pard\plain\deftab360")
+        If (PosHeaderEnd = 0) Then
+            sTestString = "\uc1\pard\f0\fs20\lang1031"
+            PosHeaderEnd = InStr(rtf, sTestString)
+        End If
+        If (PosHeaderEnd = 0) Then
+            sTestString = "\viewkind4\uc1\pard\f0\fs20"
+            PosHeaderEnd = InStr(rtf, sTestString)
+        End If
+        If (PosHeaderEnd = 0) Then
+            sTestString = "\pard\f0\fs20\lang1031"
+            PosHeaderEnd = InStr(rtf, sTestString)
+        End If
+        
+        rtf = mid(rtf, PosHeaderEnd + Len(sTestString))
+        
+        rtf = "{\rtf1\ansi\ansicpg1252 \deff0{\fonttbl" & vbCrLf & _
+                "{\f0\fswiss\fcharset0 Courier New;}}" & vbCrLf & _
+                "{\colortbl\red0\green0\blue0;\red106\green44\blue44;\red44\green106\blue44;\red44\green44\blue106;}" & vbCrLf & _
+                rtf
+                
+        lines = Split(rtf, vbCrLf)
+        Dim s As String
+        For i = LBound(lines) To UBound(lines)
+            n = QuoteFixMacro.CalcNesting(lines(i)).level
+            If (n = 0) Then
+                resRTF = resRTF & lines(i) & vbCrLf
+            Else
+                If (Right(lines(i), 4) = "\par") Then
+                    s = Left(lines(i), Len(lines(i)) - Len("\par"))
+                    resRTF = resRTF & "\cf" & n Mod NUM_RTF_COLORS & " " & s & "\cf0  " & "\par" & vbCrLf
+                Else
+                    resRTF = resRTF & "\cf" & n Mod NUM_RTF_COLORS & " " & lines(i) & "\cf0  " & vbCrLf
+                End If
+            End If
+        Next i
+    Else
+        Debug.Print "error while reading rtf! " & ret
+        ColorizeMailItem = ""
+        Exit Function
+    End If
+    
+    'remove some rtf commands
+    resRTF = Replace(resRTF, "\viewkind4\uc1", "")
+    resRTF = Replace(resRTF, "\uc1", "")
+    'VERY IMPORTANT, outlook will change the message back to PlainText otherwise!!!
+    resRTF = Replace(resRTF, "\fromtext", "")
+    Debug.Print resRTF
+    
+       
+    'write RTF back to form
+    ret = WriteRTF("MAPI", MyMailItem.EntryID, folder.StoreID, resRTF)
+    If (ret = 0) Then
+        Debug.Print "rtf write okay"
+    Else
+        Debug.Print "rtf write FAILURE"
+        ColorizeMailItem = ""
+        Exit Function
+    End If
+    
+    
+    'dereference all objects! otherwise, rtf isn't going to be updated!
+    Set folder = Nothing
+    'save return value
+    ColorizeMailItem = MyMailItem.EntryID
+    Set MyMailItem = Nothing
+End Function
+
+
+Public Sub DisplayMailItemByID(id As String)
+    Dim it As MailItem
+    Set it = Session.GetItemFromID(id, Session.GetDefaultFolder(olFolderInbox).StoreID)
+    it.Display
+    Set it = Nothing
+End Sub
+
+


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[94] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2011-04-30 15:13:59

Revision: 94
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=94&view=rev
Author:   olly98
Date:     2011-04-30 15:13:53 +0000 (Sat, 30 Apr 2011)

Log Message:
-----------
rewrote date recognition. %SE works in condensed headers, too.

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-29 13:45:39 UTC (rev 93)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-30 15:13:53 UTC (rev 94)
@@ -526,56 +526,64 @@
                     
                     Dim posColon As Integer
                     
-                    'Name
+                    'Name and Email
                     i = i + 1
                     Dim sName As String
-                    sName = StripLine(rows(i))
-                    posColon = InStr(sName, ":")
+                    Dim sEmail As String
+                    curLine = StripLine(rows(i))
+                    posColon = InStr(curLine, ":")
                     Dim posLeftBracket As String
-                    posLeftBracket = InStr(sName, "[") '[ is the indication of the beginning of the E-Mail-Adress
+                    Dim posRightBracket As Integer
+                    posLeftBracket = InStr(curLine, "[") '[ is the indication of the beginning of the E-Mail-Adress
+                    posRightBracket = InStr(curLine, "]")
                     If (posLeftBracket) > 0 Then
-                        sName = mid(sName, posColon + 2, posLeftBracket - posColon - 3)
+                        sName = mid(curLine, posColon + 2, posLeftBracket - posColon - 3)
+                        If posRightBracket = 0 Then
+                            sEmail = mid(curLine, posLeftBracket + 8) '8 = Len("mailto: ")
+                        Else
+                            sEmail = mid(curLine, posLeftBracket + 8, posRightBracket - posLeftBracket - 8) '8 = Len("mailto: ")
+                        End If
                     Else
-                        sName = mid(sName, posColon + 2)
+                        sName = mid(curLine, posColon + 2)
+                        sEmail = ""
                     End If
                     
+                    i = i + 1
+                    curLine = StripLine(rows(i))
+                    If InStr(curLine, ":") = 0 Then
+                        'There is a wrap in the email-Adress
+                        posRightBracket = InStr(curLine, "]")
+                        If posRightBracket > 0 Then
+                            sEmail = sEmail + Left(curLine, posRightBracket - 1)
+                        Else
+                            'something wrent wrong, do nothing
+                        End If
+                        'go to next line
+                        i = i + 1
+                        curLine = StripLine(rows(i))
+                    End If
+                    
                     'Date
-                    i = i + 1
+                    'We assume that there is always a weekday present before the date
                     Dim sDate As String
                     sDate = StripLine(rows(i))
-                    posColon = InStr(sDate, ":")
-                    sDate = mid(sDate, posColon + 2)
-                    posColon = InStr(sDate, ",")
-                    Dim posComma As Integer
-                    posComma = InStr(posColon + 1, sDate, ",")
-                    If posComma <> 0 Then
-                        'in case there are two ",", the first one separates a weekdate from the date
-                        sDate = mid(sDate, posColon + 2)
+                    'posColon = InStr(sDate, ":")
+                    'sDate = mid(sDate, posColon + 2)
+                    Dim posFirstComma As Integer
+                    posFirstComma = InStr(sDate, ",")
+                    sDate = mid(sDate, posFirstComma + 2)
+                    Dim dDate As Date
+                    If IsDate(sDate) Then
+                        dDate = DateValue(sDate)
+                        'there is no function "IsTime", therefore try with brute force
+                        dDate = dDate + TimeValue(sDate)
                     End If
-                    Dim dDate As Date
-                    On Error GoTo DateFailureOne
-                    dDate = DateValue(sDate)
-                    GoTo DateSuccess
-DateFailureOne:     On Error GoTo DateFailure
-                    'Possibly the first thing before the "," is a weekday  some langauges only do not use a "," in the date
-                    posColon = InStr(sDate, ",") 'Outlook puts the weekday before the actual date. DateValue() cannot deal with that. Thus, strip the weekday.
-                    sDate = mid(sDate, posColon + 2)
-                    If IsDate(sDate) Then dDate = DateValue(sDate)
-
-DateSuccess:        On Error GoTo TimeFailure
-                    Dim dTime As Date
-                    If IsDate(sDate) Then dTime = TimeValue(sDate)
-                    dDate = dDate + dTime
-TimeFailure:        On Error GoTo 0
                     If dDate <> CDate("00:00:00") Then
                         sDate = Format(dDate, DATE_FORMAT)
                     Else
-                        sDate = ""
+                        'leave sDate as is -> date is output as found in email
                     End If
                     
-DateFailure:        'leave sDate as is -> date is output as found in email
-
-DateTimeContinue:   On Error GoTo 0
                     i = i + 3 'skip next three lines (To, [possibly CC], Subject, empty line)
                     'if CC exists, then i points to the empty line
                     'if CC does not exist, then i points to the first non-empty line
@@ -591,6 +599,7 @@
                     condensedHeader = CONDENSED_HEADER_FORMAT
                     condensedHeader = Replace(condensedHeader, PATTERN_SENDER_NAME, sName)
                     condensedHeader = Replace(condensedHeader, PATTERN_SENT_DATE, sDate)
+                    condensedHeader = Replace(condensedHeader, PATTERN_SENDER_EMAIL, sEmail)
                     
                     Dim prefix As String
                     'the prefix for the result has to be one level shorter as it is the quoted text from the sender


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[93] quotefixmacro/trunk

From: <ol...@us...> - 2011-04-29 13:45:45

Revision: 93
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=93&view=rev
Author:   olly98
Date:     2011-04-29 13:45:39 +0000 (Fri, 29 Apr 2011)

Log Message:
-----------
merged SoftWrapMacro into QuoteFixMacro

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Removed Paths:
-------------
    quotefixmacro/trunk/SoftWrapMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-29 08:16:12 UTC (rev 92)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-29 13:45:39 UTC (rev 93)
@@ -93,6 +93,7 @@
 '  * Added CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER
 '  * Fixed compile time constants to work with Outlook 2007 and 2010
 '  * Added support for custom template configured in the macro (QUOTING_TEMPLATE) - this can be used instead of the signature configuration
+'  * Merged SoftWrap into QuoteFixMacro.bas
 
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -115,7 +116,7 @@
 '*** Constants for conditional compiling ***
 '
 'Enter these constants in the VBA project properties. The lines here only document the
-'available constants. Multiple entries can be separated via colon
+'available constants.
 '--------------------------------------------------------
 
 'Should mails be colorized? (needs QuoteColorizerMacro.bas)
@@ -123,16 +124,24 @@
 '#Const USE_COLORIZER = True 'Outlook 2010
 'USE_COLORIZER = -1 'Outlook 2003 and 2007
 
+
+'--------------------------------------------------------
+'*** Feature configuration ***
+'--------------------------------------------------------
 'Enable SoftWrap
 'resize window so that the text editor wraps the text automatically
 'after N charaters. Outlook wraps text automatically after sending it,
 'but doesn't display the wrap when editing
 'you can edit the auto wrap setting at "Tools / Options / Email Format / Internet Format"
-'(Different configuration formats for Outlook 2010 and older outlooks. Please choose the right variant)
-'#Const USE_SOFTWRAP = True 'Outlook 2010
-'USE_SOFTWRAP = -1 'Outlook 2003 and 2007
+Private Const USE_SOFTWRAP = False
 
+'put as much characters as set in Outlook at "Tools / Options / Email Format / Internet Format"
+Private Const SEVENTY_SIX_CHARS As String = "123456789x123456789x123456789x123456789x123456789x123456789x123456789x123456"
 
+'This constant has to be adapted to fit your needs (incoprating the used font, display size, ...)
+Private Const PIXEL_PER_CHARACTER As Double = 8.61842105263158
+
+
 '--------------------------------------------------------
 '*** Configuration constants ***
 '--------------------------------------------------------
@@ -160,6 +169,7 @@
 "%SN wrote on %D:" & vbCr & _
 "%Q"
 
+
 '--------------------------------------------------------
 '*** Configuration of condensing ***
 '--------------------------------------------------------
@@ -791,7 +801,7 @@
     
     NewMail.Body = MySignature
     
-    'Extensions, in case Colorize and SoftWrap are activated
+    'Extensions, in case Colorize is activated
     #If USE_COLORIZER Then
         Dim mailID As String
         mailID = QuoteColorizerMacro.ColorizeMailItem(NewMail)
@@ -812,13 +822,12 @@
         SendKeys "{DOWN}"
     Next i
 
-        #If USE_SOFTWRAP Then
-                Call SoftWrapMacro.ResizeWindowForSoftWrap
-        #End If
+    If USE_SOFTWRAP Then
+           Call ResizeWindowForSoftWrap
+    End If
 
-        'mark original mail as read
+    'mark original mail as read
     OriginalMail.UnRead = False
-
 End Sub
 
 
@@ -1061,3 +1070,16 @@
     StripQuotes = res
 End Function
 
+
+'resize window so that the text editor wraps the text automatically
+'after N charaters. Outlook wraps text automatically after sending it,
+'but doesn't display the wrap when editing
+'you can edit the auto wrap setting at "Tools / Options / Email Format / Internet Format"
+Public Sub ResizeWindowForSoftWrap()
+    'Application.ActiveInspector.CurrentItem.Body = SEVENTY_SIX_CHARS
+    If (TypeName(Application.ActiveWindow) = "Inspector") And Not _
+        (Application.ActiveInspector.WindowState = olMaximized) Then
+            
+        Application.ActiveInspector.Width = (LINE_WRAP_AFTER + 2) * PIXEL_PER_CHARACTER
+    End If
+End Sub

Deleted: quotefixmacro/trunk/SoftWrapMacro.bas
===================================================================
--- quotefixmacro/trunk/SoftWrapMacro.bas	2011-04-29 08:16:12 UTC (rev 92)
+++ quotefixmacro/trunk/SoftWrapMacro.bas	2011-04-29 13:45:39 UTC (rev 93)
@@ -1,53 +0,0 @@
-Attribute VB_Name = "SoftWrapMacro"
-'$Id$
-'
-'SoftWrapMacro TRUNK
-'
-'SoftWrapMacro is part of the macros4outlook project
-'see http://sourceforge.net/projects/macros4outlook/ for more information
-'
-'For more information on Outlook see http://www.microsoft.com/outlook
-'Outlook is (C) by Microsoft
-
-'****************************************************************************
-'License:
-'
-'SoftWrapMacro
-'  copyright 2006-2009 Daniel Martin. All rights reserved.
-'
-'
-'Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
-'
-'   1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
-'   2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
-'   3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission.
-'
-'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-'****************************************************************************
-
-'Changelog
-'
-'Version 1.0 - 2011-04-22
-' * first public relese
-'
-'$Revision$ - not released
-
-Option Explicit
-
-Private Const SEVENTY_SIX_CHARS As String = "123456789x123456789x123456789x123456789x123456789x123456789x123456789x123456"
-
-'This constant has to be adapted to fit your needs (incoprating the used font, display size, ...)
-Private Const PIXEL_PER_CHARACTER As Double = 8.61842105263158
-
-'resize window so that the text editor wraps the text automatically
-'after N charaters. Outlook wraps text automatically after sending it,
-'but doesn't display the wrap when editing
-'you can edit the auto wrap setting at "Tools / Options / Email Format / Internet Format"
-Public Sub ResizeWindowForSoftWrap()
-    'Application.ActiveInspector.CurrentItem.Body = SEVENTY_SIX_CHARS
-    If (TypeName(Application.ActiveWindow) = "Inspector") And Not _
-        (Application.ActiveInspector.WindowState = olMaximized) Then
-            
-        Application.ActiveInspector.Width = (LINE_WRAP_AFTER + 2) * PIXEL_PER_CHARACTER
-    End If
-End Sub


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[92] quotefixmacro/trunk/QuoteFixMacro.bas

From: <lar...@us...> - 2011-04-29 08:16:18

Revision: 92
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=92&view=rev
Author:   larsen255
Date:     2011-04-29 08:16:12 +0000 (Fri, 29 Apr 2011)

Log Message:
-----------
fixed "type mismatch" error when "From: " line is so long that it gets wrapped

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-29 08:04:54 UTC (rev 91)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-29 08:16:12 UTC (rev 92)
@@ -550,14 +550,18 @@
                     'Possibly the first thing before the "," is a weekday  some langauges only do not use a "," in the date
                     posColon = InStr(sDate, ",") 'Outlook puts the weekday before the actual date. DateValue() cannot deal with that. Thus, strip the weekday.
                     sDate = mid(sDate, posColon + 2)
-                    dDate = DateValue(sDate)
+                    If IsDate(sDate) Then dDate = DateValue(sDate)
 
 DateSuccess:        On Error GoTo TimeFailure
                     Dim dTime As Date
-                    dTime = TimeValue(sDate)
+                    If IsDate(sDate) Then dTime = TimeValue(sDate)
                     dDate = dDate + dTime
 TimeFailure:        On Error GoTo 0
-                    sDate = Format(dDate, DATE_FORMAT)
+                    If dDate <> CDate("00:00:00") Then
+                        sDate = Format(dDate, DATE_FORMAT)
+                    Else
+                        sDate = ""
+                    End If
                     
 DateFailure:        'leave sDate as is -> date is output as found in email
 


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[91] quotefixmacro/trunk/QuoteFixMacro.bas

From: <lar...@us...> - 2011-04-29 08:05:00

Revision: 91
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=91&view=rev
Author:   larsen255
Date:     2011-04-29 08:04:54 +0000 (Fri, 29 Apr 2011)

Log Message:
-----------
typos

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-29 07:36:52 UTC (rev 90)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-29 08:04:54 UTC (rev 91)
@@ -579,7 +579,7 @@
                     condensedHeader = Replace(condensedHeader, PATTERN_SENT_DATE, sDate)
                     
                     Dim prefix As String
-                    'the Prefix for the result has to be one level shorter as it is the quoted text is form the sender
+                    'the prefix for the result has to be one level shorter as it is the quoted text from the sender
                     If (curNesting.level = 1) Then
                         prefix = ""
                     Else


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[90] quotefixmacro/trunk/QuoteFixMacro.bas

From: <lar...@us...> - 2011-04-29 07:36:58

Revision: 90
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=90&view=rev
Author:   larsen255
Date:     2011-04-29 07:36:52 +0000 (Fri, 29 Apr 2011)

Log Message:
-----------
fixed out-of-bounds error

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-28 22:07:49 UTC (rev 89)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-29 07:36:52 UTC (rev 90)
@@ -570,7 +570,7 @@
                     Do
                         i = i + 1
                         curLine = StripLine(rows(i))
-                    Loop Until (curLine <> "") Or (i > UBound(rows))
+                    Loop Until (curLine <> "") Or (i = UBound(rows))
                     i = i - 1 'i now points to the last empty line
                     
                     Dim condensedHeader As String


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Macros4outlook-commitlog] SF.net SVN: macros4outlook:[89] quotefixmacro/trunk/QuoteFixMacro.bas

From: <ol...@us...> - 2011-04-28 22:07:55

Revision: 89
          http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=89&view=rev
Author:   olly98
Date:     2011-04-28 22:07:49 +0000 (Thu, 28 Apr 2011)

Log Message:
-----------
added support for USE_QUOTING_TEMPLATE

Modified Paths:
--------------
    quotefixmacro/trunk/QuoteFixMacro.bas

Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-28 20:55:38 UTC (rev 88)
+++ quotefixmacro/trunk/QuoteFixMacro.bas	2011-04-28 22:07:49 UTC (rev 89)
@@ -91,7 +91,8 @@
 '  * Added CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS, which condenses quoted outlook headers
 '    The format of the condensed header is configured at CONDENSED_HEADER_FORMAT
 '  * Added CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER
-'  * Fixed compile time constants to work with Outlook 2007
+'  * Fixed compile time constants to work with Outlook 2007 and 2010
+'  * Added support for custom template configured in the macro (QUOTING_TEMPLATE) - this can be used instead of the signature configuration
 
 'Ideas were taken from
 '  * Daniele Bochicchio
@@ -151,7 +152,14 @@
 'Automatically convert HTML/RTF-Mails to plain text?
 Private Const CONVERT_TO_PLAIN As Boolean = False
 
+'Enable QUOTING_TEMPLATE
+Private Const USE_QUOTING_TEMPLATE As Boolean = False
 
+'If the constant USE_QUOTING_TEMPLATE is set, this template is used instead of the signature
+Private Const QUOTING_TEMPLATE As String = _
+"%SN wrote on %D:" & vbCr & _
+"%Q"
+
 '--------------------------------------------------------
 '*** Configuration of condensing ***
 '--------------------------------------------------------
@@ -708,6 +716,10 @@
     MySignature = getSignature(BodyLines, lineCounter)
     ' lineCounter now indicates the line after the signature
    
+    If USE_QUOTING_TEMPLATE Then
+        'Override MySignature in case the QUOTING_TEMPLATE should be used
+        MySignature = QUOTING_TEMPLATE
+    End If
 
     Dim senderName As String
     Dim firstName As String


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

Flat | Threaded

1 2 3 > >> (Page 1 of 3)

2009	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct (4)	Nov	Dec
2010	Jan (1)	Feb	Mar	Apr	May (2)	Jun	Jul (2)	Aug	Sep (1)	Oct	Nov	Dec
2011	Jan	Feb (1)	Mar (1)	Apr (37)	May (4)	Jun (1)	Jul (2)	Aug	Sep (1)	Oct (2)	Nov	Dec
2012	Jan (5)	Feb	Mar	Apr	May	Jun (2)	Jul (1)	Aug	Sep	Oct	Nov	Dec