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. |