Menu
▾
▴
macros4outlook-commitlog
|
From: <lar...@us...> - 2009-10-15 14:01:30
|
Revision: 48
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=48&view=rev
Author: larsen255
Date: 2009-10-15 14:00:48 +0000 (Thu, 15 Oct 2009)
Log Message:
-----------
proposed fix for bug 2869202
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2009-10-14 12:51:59 UTC (rev 47)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2009-10-15 14:00:48 UTC (rev 48)
@@ -377,7 +377,7 @@
lastLineWasParagraph = False
If (curNesting.level = 1) And (i < UBound(rows)) Then
- 'possibly a wrong break is found
+ '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
@@ -664,19 +664,26 @@
Set gal = OriginalMail.Session.GetGlobalAddressList
Set exchAddressEntries = gal.AddressEntries
- Set exchAddressEntry = exchAddressEntries.GetFirst
+
+ '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
'Names are returned by reference
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2010-01-07 21:21:16
|
Revision: 50
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=50&view=rev
Author: olly98
Date: 2010-01-07 21:21:09 +0000 (Thu, 07 Jan 2010)
Log Message:
-----------
changed contact data
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2009-10-15 14:05:31 UTC (rev 49)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2010-01-07 21:21:09 UTC (rev 50)
@@ -16,8 +16,10 @@
'
'If you don't have money (or don't like the software that much, but
'appreciate the development), please send an email to
-'theurgists [at] flupp [dot] de
+'macros4outlook-users -> lists.sourceforge.net.
'
+'For bug reports please go to our sourceforge bugtracker: http://sourceforge.net/projects/macros4outlook/support
+'
'Thank you :-)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2010-05-20 21:57:06
|
Revision: 51
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=51&view=rev
Author: olly98
Date: 2010-05-20 21:57:00 +0000 (Thu, 20 May 2010)
Log Message:
-----------
added Id keyword
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Property Changed:
----------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2010-01-07 21:21:09 UTC (rev 50)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2010-05-20 21:57:00 UTC (rev 51)
@@ -1,4 +1,5 @@
Attribute VB_Name = "QuoteFixMacro"
+'$Id$
'QuoteFix Macro TRUNK
'QuoteFix Macro is part of the macros4outlook project
'see http://sourceforge.net/projects/macros4outlook/ for more information
Property changes on: quotefixmacro/trunk/QuoteFixMacro.bas
___________________________________________________________________
Added: svn:keywords
+ Id
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2010-05-20 22:03:13
|
Revision: 52
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=52&view=rev
Author: olly98
Date: 2010-05-20 22:03:07 +0000 (Thu, 20 May 2010)
Log Message:
-----------
quickly fixed %SE bug at Outlook 2003
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2010-05-20 21:57:00 UTC (rev 51)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2010-05-20 22:03:07 UTC (rev 52)
@@ -17,7 +17,7 @@
'
'If you don't have money (or don't like the software that much, but
'appreciate the development), please send an email to
-'macros4outlook-users -> lists.sourceforge.net.
+'macros4outlook-users -> lists.sourceforge.net.
'
'For bug reports please go to our sourceforge bugtracker: http://sourceforge.net/projects/macros4outlook/support
'
@@ -556,10 +556,12 @@
Dim firstName As String
Call getNames(OriginalMail, fromName, firstName)
- Dim senderEmail As String
- senderEmail = getSenderEmailAdress(OriginalMail)
+ 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_SENDER_EMAIL, senderEmail)
MySignature = Replace(MySignature, PATTERN_FIRST_NAME, firstName)
MySignature = Replace(MySignature, PATTERN_SENT_DATE, Format(OriginalMail.SentOn, DATE_FORMAT))
MySignature = Replace(MySignature, PATTERN_SENDER_NAME, fromName)
@@ -665,6 +667,7 @@
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
@@ -839,5 +842,3 @@
StripQuotes = res
End Function
-
-
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <lar...@us...> - 2010-07-21 13:55:19
|
Revision: 54
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=54&view=rev
Author: larsen255
Date: 2010-07-21 13:55:11 +0000 (Wed, 21 Jul 2010)
Log Message:
-----------
fixed bug tracker ID 3030953: %OH was not replaced by the Outlook Header
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2010-07-21 13:44:52 UTC (rev 53)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2010-07-21 13:55:11 UTC (rev 54)
@@ -586,7 +586,7 @@
End Select
'Put text in signature (=Template for text)
- MySignature = Replace(MySignature, "PATTERN_OUTLOOK_HEADER" & vbCrLf, OutlookHeader)
+ MySignature = Replace(MySignature, PATTERN_OUTLOOK_HEADER & vbCrLf, OutlookHeader)
If InStr(MySignature, PATTERN_QUOTED_TEXT) <> 0 Then
MySignature = Replace(MySignature, PATTERN_QUOTED_TEXT, NewText)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <lar...@us...> - 2010-09-28 07:24:53
|
Revision: 55
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=55&view=rev
Author: larsen255
Date: 2010-09-28 07:24:46 +0000 (Tue, 28 Sep 2010)
Log Message:
-----------
Added option to automatically convert HTML/RTF-Mails to plain text
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2010-07-21 13:55:11 UTC (rev 54)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2010-09-28 07:24:46 UTC (rev 55)
@@ -118,6 +118,9 @@
'Strip the sender\xB4s signature?
Private Const STRIP_SIGNATURE As Boolean = True
+
+'Automatically convert HTML/RTF-Mails to plain text?
+Private Const CONVERT_TO_PLAIN As Boolean = False
'--------------------------------------------------------
'Private Const Outlook_OriginalMessage = "> -----Urspr?ngliche Nachricht-----"
@@ -502,22 +505,27 @@
Dim OriginalMail As MailItem
Set OriginalMail = SelectedObject 'cast!!!
+
'we don\xB4t understand HTML mails!!!
If Not (OriginalMail.BodyFormat = olFormatPlain) Then
- 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
+ If CONVERT_TO_PLAIN Then
+ 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!
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <lar...@us...> - 2011-02-22 15:59:02
|
Revision: 56
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=56&view=rev
Author: larsen255
Date: 2011-02-22 15:58:53 +0000 (Tue, 22 Feb 2011)
Log Message:
-----------
prevent replying to mails that are saved as drafts
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2010-09-28 07:24:46 UTC (rev 55)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-02-22 15:58:53 UTC (rev 56)
@@ -506,7 +506,13 @@
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
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <lar...@us...> - 2011-03-14 15:02:24
|
Revision: 57
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=57&view=rev
Author: larsen255
Date: 2011-03-14 15:02:18 +0000 (Mon, 14 Mar 2011)
Log Message:
-----------
added comment explaining the problem with converted mails (cannot be converted back to HTML/RTF)
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-02-22 15:58:53 UTC (rev 56)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-03-14 15:02:18 UTC (rev 57)
@@ -516,6 +516,10 @@
'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
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-22 12:23:30
|
Revision: 60
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=60&view=rev
Author: olly98
Date: 2011-04-22 12:23:24 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
added handling for "Dr.", prepared GetNames() for testing, added conditional compile option for SoftWrapMacro
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 11:25:58 UTC (rev 59)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 12:23:24 UTC (rev 60)
@@ -29,7 +29,7 @@
'****************************************************************************
'License:
'
-'QuoteFix Macro
+'QuoteFix Macro
' copyright 2006-2009 Oliver Kopp and Daniel Martin. All rights reserved.
' copyright 2010-2011 Oliver Kopp and Lars Monsees. All rights reserved.
'
@@ -75,13 +75,16 @@
' * if no firstname is found, then the destination is used
' * "firstname.lastname@domain" is supported
' * firstName always starts with an uppercase letter
-' * added call to QuoteColorizerMacro and SoftWrapMacro (if constant USE_COLORIZER for conditional compiling is set)
+' * 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
'Ideas were taken from
' * Daniele Bochicchio
@@ -106,9 +109,17 @@
'Enter these constants in the VBA project properties. The lines here only document the
'available constants. Multiple entries can be separated via colon
'--------------------------------------------------------
+
'Should mails be colorized? (needs QuoteColorizerMacro.bas)
-'USE_COLORIZER = -1
+'USE_COLORIZER = 1
+'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"
+'USE_SOFTWRAP = 1
+
'--------------------------------------------------------
'*** Configuration constants ***
'--------------------------------------------------------
@@ -129,8 +140,8 @@
Private Const CONVERT_TO_PLAIN As Boolean = False
'--------------------------------------------------------
-'Private Const Outlook_OriginalMessage = "> -----Urspr?ngliche Nachricht-----"
-'Private Const Outlook_OriginalMessage = "> -----Original Message-----"
+'Private Const OUTLOOK_ORIGINALMESSAGE = "> -----Urspr\xFCngliche Nachricht-----"
+'Private Const OUTLOOK_ORIGINALMESSAGE = "> -----Original Message-----"
Private Const OUTLOOK_ORIGINALMESSAGE As String = "> -----"
Private Const OUTLOOK_HEADERFINISH As String = "> "
Private Const SIGNATURE_SEPARATOR As String = "> --"
@@ -576,9 +587,9 @@
MySignature = getSignature(BodyLines, lineCounter)
- Dim fromName As String
+ Dim senderName As String
Dim firstName As String
- Call getNames(OriginalMail, fromName, firstName)
+ Call getNames(OriginalMail, senderName, firstName)
If InStr(MySignature, PATTERN_SENDER_EMAIL) <> 0 Then
Dim senderEmail As String
@@ -588,7 +599,7 @@
MySignature = Replace(MySignature, PATTERN_FIRST_NAME, firstName)
MySignature = Replace(MySignature, PATTERN_SENT_DATE, Format(OriginalMail.SentOn, DATE_FORMAT))
- MySignature = Replace(MySignature, PATTERN_SENDER_NAME, fromName)
+ MySignature = Replace(MySignature, PATTERN_SENDER_NAME, senderName)
Dim OutlookHeader As String
@@ -635,7 +646,6 @@
'remove cursor_position pattern from mail text
MySignature = Replace(MySignature, PATTERN_CURSOR_POSITION, "")
-
NewMail.Body = MySignature
'Extensions, in case Colorize and SoftWrap are activated
@@ -644,13 +654,18 @@
mailID = QuoteColorizerMacro.ColorizeMailItem(NewMail)
If (Trim("" & mailID) <> "") Then 'no error occured or quotefix macro not there...
Call QuoteColorizerMacro.DisplayMailItemByID(mailID)
- Call SoftWrapMacro.ResizeWindowForSoftWrap
+ #If USE_SOFTWRAP Then
+ Call SoftWrapMacro.ResizeWindowForSoftWrap
+ #End If
Else
'Display window
NewMail.Display
End If
#Else
NewMail.Display
+ #If USE_SOFTWRAP Then
+ Call SoftWrapMacro.ResizeWindowForSoftWrap
+ #End If
#End If
'jump to the right place
@@ -696,8 +711,8 @@
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
+ 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)
@@ -716,49 +731,86 @@
End Function
-'Names are returned by reference
-Private Sub getNames(ByRef OriginalMail As MailItem, ByRef fromName As String, ByRef firstName As String)
+'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
- 'Wildcard replaces
- fromName = OriginalMail.SentOnBehalfOfName
+ Dim tmpName As String
+ tmpName = originalName
+ senderName = originalName
- If fromName = "" Then
- fromName = OriginalMail.SenderName
- End If
-
'default: fullname
- firstName = fromName
+ firstName = tmpName
+ Dim title As String
+ title = ""
+ 'Has to be later used for extracting the last name
+
Dim pos As Integer
- pos = InStr(fromName, ",")
+ 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(fromName, pos + 1))
+ firstName = Trim(mid(tmpName, pos + 1))
Else
- pos = InStr(fromName, " ")
+ pos = InStr(tmpName, " ")
If pos > 0 Then
- firstName = Trim(Left(fromName, pos - 1))
+ '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(fromName, pos + 1))
+ firstName = Trim(mid(tmpName, pos + 1))
End If
Else
- pos = InStr(fromName, "@")
+ pos = InStr(tmpName, "@")
If pos > 0 Then
- firstName = Left(fromName, pos - 1)
+ 'first name is (currenty) an eMail-Adress. Just take the prefix
+ tmpName = Left(tmpName, pos - 1)
End If
- pos = InStr(firstName, ".")
+ pos = InStr(tmpName, ".")
If pos > 0 Then
- firstName = Left(firstName, pos - 1)
+ 'first name is separated by a dot
+ tmpName = Left(tmpName, pos - 1)
End If
+ firstName = tmpName
End If
End If
- 'fix casing of firstname
+ '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
@@ -866,3 +918,4 @@
StripQuotes = res
End Function
+
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-22 13:55:49
|
Revision: 68
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=68&view=rev
Author: olly98
Date: 2011-04-22 13:55:43 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
fixed conditional compiles
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Property Changed:
----------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 13:54:19 UTC (rev 67)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 13:55:43 UTC (rev 68)
@@ -64,7 +64,7 @@
'Version 1.2b - 2007-01-24
' * included on-behalf-of handling written by Per Soderlind (per [at] soderlind [dot] no)
'
-'Version TRUNK - not released
+'$Revision$ - not released
' * included %C patch 2778722 by Karsten Heimrich
' * included %SE patch 2807638 by Peter Lindgren
' * check for beginning of quote is now language independent
@@ -111,14 +111,14 @@
'--------------------------------------------------------
'Should mails be colorized? (needs QuoteColorizerMacro.bas)
-'USE_COLORIZER = 1
+'#Const USE_COLORIZER = True
'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"
-'USE_SOFTWRAP = 1
+'#Const USE_SOFTWRAP = True
'--------------------------------------------------------
'*** Configuration constants ***
Property changes on: quotefixmacro/trunk/QuoteFixMacro.bas
___________________________________________________________________
Modified: svn:keywords
- Id
+ Id Revision
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-22 15:09:48
|
Revision: 70
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=70&view=rev
Author: olly98
Date: 2011-04-22 15:09:42 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
added forgotten call to SoftWrapMacro
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 14:26:04 UTC (rev 69)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 15:09:42 UTC (rev 70)
@@ -660,8 +660,12 @@
Else
'Display window
NewMail.Display
+ #If USE_SOFTWRAP Then
+ Call SoftWrapMacro.ResizeWindowForSoftWrap
+ #End If
End If
#Else
+ 'Display window
NewMail.Display
#If USE_SOFTWRAP Then
Call SoftWrapMacro.ResizeWindowForSoftWrap
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-22 16:26:46
|
Revision: 73
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=73&view=rev
Author: olly98
Date: 2011-04-22 16:26:40 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
fixed cursor position in the case of absence of "%C", but presence of "%Q"
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 16:12:47 UTC (rev 72)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 16:26:40 UTC (rev 73)
@@ -85,6 +85,7 @@
' * 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"
'Ideas were taken from
' * Daniele Bochicchio
@@ -623,28 +624,26 @@
'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
-
-
- 'Calculate number of downs to sent
- Dim downCount As Long
- downCount = -1
-
If (InStr(MySignature, PATTERN_CURSOR_POSITION) <> 0) Then
downCount = CalcDownCount(PATTERN_CURSOR_POSITION, MySignature)
- ElseIf InStr(MySignature, PATTERN_QUOTED_TEXT) <> 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)
+ 'remove cursor_position pattern from mail text
+ MySignature = Replace(MySignature, PATTERN_CURSOR_POSITION, "")
End If
-
- 'remove cursor_position pattern from mail text
- MySignature = Replace(MySignature, PATTERN_CURSOR_POSITION, "")
NewMail.Body = MySignature
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-22 16:55:43
|
Revision: 75
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=75&view=rev
Author: olly98
Date: 2011-04-22 16:55:37 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
SoftWrap now works together with %C
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 16:38:15 UTC (rev 74)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 16:55:37 UTC (rev 75)
@@ -655,22 +655,13 @@
mailID = QuoteColorizerMacro.ColorizeMailItem(NewMail)
If (Trim("" & mailID) <> "") Then 'no error occured or quotefix macro not there...
Call QuoteColorizerMacro.DisplayMailItemByID(mailID)
- #If USE_SOFTWRAP Then
- Call SoftWrapMacro.ResizeWindowForSoftWrap
- #End If
Else
'Display window
NewMail.Display
- #If USE_SOFTWRAP Then
- Call SoftWrapMacro.ResizeWindowForSoftWrap
- #End If
End If
#Else
'Display window
NewMail.Display
- #If USE_SOFTWRAP Then
- Call SoftWrapMacro.ResizeWindowForSoftWrap
- #End If
#End If
'jump to the right place
@@ -679,7 +670,11 @@
SendKeys "{DOWN}"
Next i
- 'mark original mail as read
+ #If USE_SOFTWRAP Then
+ Call SoftWrapMacro.ResizeWindowForSoftWrap
+ #End If
+
+ 'mark original mail as read
OriginalMail.UnRead = False
End Sub
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-23 20:00:57
|
Revision: 82
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=82&view=rev
Author: olly98
Date: 2011-04-23 20:00:50 +0000 (Sat, 23 Apr 2011)
Log Message:
-----------
added support for condensing headers; added a bit more code comments
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-23 10:45:33 UTC (rev 81)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-23 20:00:50 UTC (rev 82)
@@ -88,6 +88,8 @@
' * fixed cursor position in the case of absence of "%C", but presence of "%Q"
'
'$Revision$ - not released
+' * Added CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS, which condenses quoted outlook headers
+' The format of the condensed header is configured at CONDENSED_HEADER_FORMAT
'Ideas were taken from
' * Daniele Bochicchio
@@ -139,13 +141,18 @@
'Strip the sender\xB4s signature?
Private Const STRIP_SIGNATURE As Boolean = True
+'Condense embedded quoted Outlook headers?
+#Const CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = True
+Private Const CONDENSED_HEADER_FORMAT = "%SN wrote on %D:"
+
'Automatically convert HTML/RTF-Mails to plain text?
Private Const CONVERT_TO_PLAIN As Boolean = False
'--------------------------------------------------------
-'Private Const OUTLOOK_ORIGINALMESSAGE = "> -----Urspr\xFCngliche Nachricht-----"
-'Private Const OUTLOOK_ORIGINALMESSAGE = "> -----Original Message-----"
-Private Const OUTLOOK_ORIGINALMESSAGE As String = "> -----"
+Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----"
+'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 = "> --"
@@ -164,10 +171,15 @@
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
- 'the sum + 1 (+1 because of the trailing space)
+ 'total = level + additionalSpacesCount + 1
total As Integer
End Type
@@ -248,7 +260,7 @@
res.additionalSpacesCount = 0
End If
- res.total = res.level + res.additionalSpacesCount + 1 '+1 = tailing space
+ res.total = res.level + res.additionalSpacesCount + 1 '+1 = trailing space
CalcNesting = res
End Function
@@ -284,7 +296,7 @@
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 "", while unformatedBlock gets <> ""
+ ' line is "". Therefore curBlock remains "", whereas unformatedBlock gets <> ""
If curLine = "" Then Exit Sub
@@ -416,7 +428,7 @@
ElseIf curNesting.total < lastNesting.total Then 'curNesting.level = lastNesting.level - 1 doesn't work, because ">>", ">>>", ... are also killed by Office
lastLineWasParagraph = False
- 'Quote is idented less. Maybe it 's a wrong line wrap of outlook?
+ 'Quote is indented less. Maybe it's a wrong line wrap of outlook?
If (i < UBound(rows)) Then
nextNesting = CalcNesting(rows(i + 1))
@@ -456,6 +468,8 @@
End If
Else
+ 'curNesting.total > lastNesting.total
+
lastLineWasParagraph = False
'it's nested one level deeper. Current block is finished
@@ -468,8 +482,56 @@
End If
End If
- 'next block starts with curLine
- AppendCurLine curLine
+ #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
+ i = i + 1
+ Dim sName As String
+ sName = StripLine(rows(i))
+ posColon = InStr(sName, ":")
+ sName = mid(sName, posColon + 2)
+
+ 'Date
+ i = i + 1
+ Dim sDate As String
+ sDate = StripLine(rows(i))
+ posColon = InStr(sDate, ":")
+ sDate = mid(sDate, posColon + 2)
+ Dim dDate As Date
+ On Error GoTo DateFailure
+ dDate = DateValue(sDate)
+
+ Dim dTime As Date
+ On Error GoTo TimeFailure
+ dTime = TimeValue(sDate)
+ dDate = dDate + dTime
+TimeFailure: On Error GoTo 0
+ sDate = Format(dDate, DATE_FORMAT)
+
+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, CC, Subject)
+
+ Dim condensedHeader As String
+ condensedHeader = CONDENSED_HEADER_FORMAT
+ condensedHeader = Replace(condensedHeader, PATTERN_SENDER_NAME, sName)
+ condensedHeader = Replace(condensedHeader, PATTERN_SENT_DATE, sDate)
+
+ result = result & curPrefix & 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
@@ -588,7 +650,8 @@
' 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
+
Dim senderName As String
Dim firstName As String
@@ -608,6 +671,7 @@
Dim OutlookHeader As String
OutlookHeader = getOutlookHeader(BodyLines, lineCounter)
+
Dim quotedText As String
quotedText = getQuotedText(BodyLines, lineCounter)
@@ -712,7 +776,7 @@
'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
+ If exchAddressEntry.name <> OriginalMail.senderName Then Set exchAddressEntry = exchAddressEntries.GetFirst
found = False
While (Not found) And (Not exchAddressEntry Is Nothing)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-23 20:20:04
|
Revision: 83
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=83&view=rev
Author: olly98
Date: 2011-04-23 20:19:58 +0000 (Sat, 23 Apr 2011)
Log Message:
-----------
added strip line functionality for condensed headers
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-23 20:00:50 UTC (rev 82)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-23 20:19:58 UTC (rev 83)
@@ -515,8 +515,15 @@
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, CC, Subject)
+ i = i + 4 'skip next four lines (To, CC, Subject, 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)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-25 23:36:57
|
Revision: 84
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=84&view=rev
Author: olly98
Date: 2011-04-25 23:36:51 +0000 (Mon, 25 Apr 2011)
Log Message:
-----------
added support for condensing the first header
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-23 20:19:58 UTC (rev 83)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-25 23:36:51 UTC (rev 84)
@@ -90,6 +90,7 @@
'$Revision$ - not released
' * 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
'Ideas were taken from
' * Daniele Bochicchio
@@ -141,12 +142,24 @@
'Strip the sender\xB4s signature?
Private Const STRIP_SIGNATURE As Boolean = True
+'Automatically convert HTML/RTF-Mails to plain text?
+Private Const CONVERT_TO_PLAIN As Boolean = False
+
+'--------------------------------------------------------
+'*** Configuration of condensing ***
+'--------------------------------------------------------
+
'Condense embedded quoted Outlook headers?
#Const CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = 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)
+#Const CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = True
+
+'Format of condensed header
Private Const CONDENSED_HEADER_FORMAT = "%SN wrote on %D:"
-'Automatically convert HTML/RTF-Mails to plain text?
-Private Const CONVERT_TO_PLAIN As Boolean = False
+
'--------------------------------------------------------
Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----"
@@ -493,13 +506,22 @@
Dim sName As String
sName = StripLine(rows(i))
posColon = InStr(sName, ":")
- sName = mid(sName, posColon + 2)
+ Dim posLeftBracket As String
+ posLeftBracket = InStr(sName, "[") '[ is the indication of the beginning of the E-Mail-Adress
+ If (posLeftBracket) > 0 Then
+ sName = mid(sName, posColon + 2, posLeftBracket - posColon - 3)
+ Else
+ sName = mid(sName, posColon + 2)
+ End If
'Date
i = i + 1
Dim sDate As String
sDate = StripLine(rows(i))
- posColon = InStr(sDate, ":")
+ posColon = InStr(sDate, ",") 'Outlook puts the weekday before the actual date. DateValue() cannot deal with that. Thus, strip the weekday.
+ If (posColon = 0) Then
+ posColon = InStr(sDate, ":")
+ End If
sDate = mid(sDate, posColon + 2)
Dim dDate As Date
On Error GoTo DateFailure
@@ -674,11 +696,17 @@
MySignature = Replace(MySignature, PATTERN_SENT_DATE, Format(OriginalMail.SentOn, DATE_FORMAT))
MySignature = Replace(MySignature, PATTERN_SENDER_NAME, senderName)
-
+
Dim OutlookHeader As String
- OutlookHeader = getOutlookHeader(BodyLines, lineCounter)
+ #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)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-25 23:58:10
|
Revision: 85
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=85&view=rev
Author: olly98
Date: 2011-04-25 23:58:04 +0000 (Mon, 25 Apr 2011)
Log Message:
-----------
fixed indent of condensed header, fixed eating of one line if no CC field exists
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-25 23:36:51 UTC (rev 84)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-25 23:58:04 UTC (rev 85)
@@ -126,6 +126,7 @@
'you can edit the auto wrap setting at "Tools / Options / Email Format / Internet Format"
'#Const USE_SOFTWRAP = True
+
'--------------------------------------------------------
'*** Configuration constants ***
'--------------------------------------------------------
@@ -145,6 +146,7 @@
'Automatically convert HTML/RTF-Mails to plain text?
Private Const CONVERT_TO_PLAIN As Boolean = False
+
'--------------------------------------------------------
'*** Configuration of condensing ***
'--------------------------------------------------------
@@ -159,9 +161,9 @@
'Format of condensed header
Private Const CONDENSED_HEADER_FORMAT = "%SN wrote on %D:"
-
'--------------------------------------------------------
+
Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----"
'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Urspr\xFCngliche Nachricht-----"
'Private Const OUTLOOK_PLAIN_ORIGINALMESSAGE = "-----Original Message-----"
@@ -537,7 +539,9 @@
DateFailure: 'leave sDate as is -> date is output as found in email
DateTimeContinue: On Error GoTo 0
- i = i + 4 'skip next four lines (To, CC, Subject, empty line)
+ 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
@@ -551,7 +555,15 @@
condensedHeader = Replace(condensedHeader, PATTERN_SENDER_NAME, sName)
condensedHeader = Replace(condensedHeader, PATTERN_SENT_DATE, sDate)
- result = result & curPrefix & condensedHeader & vbCrLf
+ 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
+ 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
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-26 00:14:59
|
Revision: 86
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=86&view=rev
Author: olly98
Date: 2011-04-26 00:14:53 +0000 (Tue, 26 Apr 2011)
Log Message:
-----------
improved handling of dates. German and English date formats seem to work
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-25 23:58:04 UTC (rev 85)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-26 00:14:53 UTC (rev 86)
@@ -520,17 +520,27 @@
i = i + 1
Dim sDate As String
sDate = StripLine(rows(i))
- posColon = InStr(sDate, ",") 'Outlook puts the weekday before the actual date. DateValue() cannot deal with that. Thus, strip the weekday.
- If (posColon = 0) Then
- posColon = InStr(sDate, ":")
+ 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)
End If
- sDate = mid(sDate, posColon + 2)
Dim dDate As Date
- On Error GoTo DateFailure
+ 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)
+ dDate = DateValue(sDate)
+
+DateSuccess: On Error GoTo TimeFailure
Dim dTime As Date
- On Error GoTo TimeFailure
dTime = TimeValue(sDate)
dDate = dDate + dTime
TimeFailure: On Error GoTo 0
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-26 18:59:40
|
Revision: 87
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=87&view=rev
Author: olly98
Date: 2011-04-26 18:59:34 +0000 (Tue, 26 Apr 2011)
Log Message:
-----------
fixed compile time constants to work with Outlook 2007 again
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-26 00:14:53 UTC (rev 86)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-26 18:59:34 UTC (rev 87)
@@ -91,6 +91,7 @@
' * 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
'Ideas were taken from
' * Daniele Bochicchio
@@ -117,14 +118,15 @@
'--------------------------------------------------------
'Should mails be colorized? (needs QuoteColorizerMacro.bas)
-'#Const USE_COLORIZER = True
+'Constant has to be "-1", as "True" only works with Outlook 2010, but not with Outlook 2007 and below
+'#Const USE_COLORIZER = -1
'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"
-'#Const USE_SOFTWRAP = True
+'#Const USE_SOFTWRAP = -1
'--------------------------------------------------------
@@ -152,11 +154,11 @@
'--------------------------------------------------------
'Condense embedded quoted Outlook headers?
-#Const CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = True
+#Const CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = -1
'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)
-#Const CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = True
+#Const CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = -1
'Format of condensed header
Private Const CONDENSED_HEADER_FORMAT = "%SN wrote on %D:"
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-28 20:55:44
|
Revision: 88
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=88&view=rev
Author: olly98
Date: 2011-04-28 20:55:38 +0000 (Thu, 28 Apr 2011)
Log Message:
-----------
compiles now at Outlook 2007 and 2010. Comments for different compiler constants Outlook2007/2010 added
Modified Paths:
--------------
quotefixmacro/trunk/QuoteFixMacro.bas
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-26 18:59:34 UTC (rev 87)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-28 20:55:38 UTC (rev 88)
@@ -19,7 +19,7 @@
'
'If you don't have money (or don't like the software that much, but
'appreciate the development), please send an email to
-'macros4outlook-users -> lists.sourceforge.net.
+'mac...@li....
'
'For bug reports please go to our sourceforge bugtracker: http://sourceforge.net/projects/macros4outlook/support
'
@@ -118,15 +118,18 @@
'--------------------------------------------------------
'Should mails be colorized? (needs QuoteColorizerMacro.bas)
-'Constant has to be "-1", as "True" only works with Outlook 2010, but not with Outlook 2007 and below
-'#Const USE_COLORIZER = -1
+'(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
'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"
-'#Const USE_SOFTWRAP = -1
+'(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
'--------------------------------------------------------
@@ -154,11 +157,11 @@
'--------------------------------------------------------
'Condense embedded quoted Outlook headers?
-#Const CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = -1
+Private Const CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS = 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)
-#Const CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = -1
+Private Const CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER = False
'Format of condensed header
Private Const CONDENSED_HEADER_FORMAT = "%SN wrote on %D:"
@@ -499,7 +502,7 @@
End If
End If
- #If CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS Then
+ If CONDENSE_EMBEDDED_QUOTED_OUTLOOK_HEADERS Then
If Left(curLine, Len(OUTLOOK_PLAIN_ORIGINALMESSAGE)) = OUTLOOK_PLAIN_ORIGINALMESSAGE Then
'We found a header
@@ -581,10 +584,10 @@
'next block starts with curLine
AppendCurLine curLine
End If
- #Else
+ Else
'next block starts with curLine
AppendCurLine curLine
- #End If
+ End If
End If
Next i
@@ -722,13 +725,13 @@
Dim OutlookHeader As String
- #If CONDENSE_FIRST_EMBEDDED_QUOTED_OUTLOOK_HEADER Then
+ 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
+ Else
OutlookHeader = getOutlookHeader(BodyLines, lineCounter)
- #End If
+ End If
Dim quotedText As String
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
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.
|
|
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.
|
|
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.
|
|
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.
|
|
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.
|
Thanks for helping keep SourceForge clean.
X