Menu
▾
▴
macros4outlook-commitlog — Mailinglist for svn commits
You can subscribe to this list here.
| 2009 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
(4) |
Nov
|
Dec
|
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2010 |
Jan
(1) |
Feb
|
Mar
|
Apr
|
May
(2) |
Jun
|
Jul
(2) |
Aug
|
Sep
(1) |
Oct
|
Nov
|
Dec
|
| 2011 |
Jan
|
Feb
(1) |
Mar
(1) |
Apr
(37) |
May
(4) |
Jun
(1) |
Jul
(2) |
Aug
|
Sep
(1) |
Oct
(2) |
Nov
|
Dec
|
| 2012 |
Jan
(5) |
Feb
|
Mar
|
Apr
|
May
|
Jun
(2) |
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
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-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-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-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-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-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-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 10:45:39
|
Revision: 81
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=81&view=rev
Author: olly98
Date: 2011-04-23 10:45:33 +0000 (Sat, 23 Apr 2011)
Log Message:
-----------
streamlined code by using IIf
Modified Paths:
--------------
quotefixmacro/trunk/TestCases_GetNames.bas
Modified: quotefixmacro/trunk/TestCases_GetNames.bas
===================================================================
--- quotefixmacro/trunk/TestCases_GetNames.bas 2011-04-22 17:33:17 UTC (rev 80)
+++ quotefixmacro/trunk/TestCases_GetNames.bas 2011-04-23 10:45:33 UTC (rev 81)
@@ -103,23 +103,9 @@
If firstNameDiffers Or senderNameDiffers Then
Debug.Print "TestCase " + CStr(curNum) + " failed:"
- Dim fiS As String
- If firstNameDiffers Then
- fiS = " <> "
- Else
- fiS = " = "
- End If
-
- Dim srS As String
- If senderNameDiffers Then
- srS = " <> "
- Else
- srS = " = "
- End If
-
Debug.Print testcase.originalName + ":"
- Debug.Print firstName + fiS + testcase.ExpectedFirstName
- Debug.Print senderName + srS + testcase.ExpectedSenderName
+ Debug.Print firstName + IIf(firstNameDiffers, " <> ", " = ") + testcase.ExpectedFirstName
+ Debug.Print senderName + IIf(senderNameDiffers, " <> ", " = ") + testcase.ExpectedSenderName
Debug.Print
'MsgBox "TestCase " + CStr(curNum) + " failed", vbExclamation
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ol...@us...> - 2011-04-22 17:33:23
|
Revision: 80
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=80&view=rev
Author: olly98
Date: 2011-04-22 17:33:17 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
preparing release
Added Paths:
-----------
remindermacro/tags/v1.0/
remindermacro/tags/v1.0/ReminderMacro.bas
Copied: remindermacro/tags/v1.0/ReminderMacro.bas (from rev 79, remindermacro/trunk/ReminderMacro.bas)
===================================================================
--- remindermacro/tags/v1.0/ReminderMacro.bas (rev 0)
+++ remindermacro/tags/v1.0/ReminderMacro.bas 2011-04-22 17:33:17 UTC (rev 80)
@@ -0,0 +1,128 @@
+Attribute VB_Name = "ReminderMacro"
+'$Id$
+'
+'Reminder Macro 1.0
+'
+'Reminder Macro is part of the macros4outlook project
+'see https://sourceforge.net/apps/mediawiki/macros4outlook/index.php?title=Reminder_Macro or
+' http://sourceforge.net/projects/macros4outlook/ for more information
+'
+'For more information on Outlook see http://www.microsoft.com/outlook
+'Outlook is (C) by Microsoft
+
+Option Explicit
+
+'------------------------------------------------------------------------------------------
+' Procedure : Jeremy's Application_ItemSend Event 1.0
+' Author : Jeremy Gollehon
+' Purpose : Warn on blank Subject line and/or no attachment (using keyword check).
+' Program works with all message types (only tested in Outlook 2003).
+'
+' DateTime : 7/05/2004, - Original concept code
+' : 8/17/2004, - Some optimization and fixing of logic errors.
+' : 8/18/2004, - Added functionality for all message types.
+' - Now searches Subject and Body for keywords.
+' - In Reply/forward's only non-quoted section of body is searched.
+' : 8/19/2004, - (Armen Stein) Changed array declaration to a Split, so that new
+' search words can be easily added in a constant.
+' : 8/20/2004, - Check to make sure code only runs on MailItem type.
+' : 8/23/2004 - Added ExactMatch function: check's to be sure the exact
+' keyword/keyphrase was found. Eg. "here it is" vs "where it is"
+' - Added EmbeddedAttachCount function (code mostly taken from
+' Outlookcode.com). It's used to determine the number of embedded
+' attachments and exlude them from the attachment count. This code
+' uses the Redemption dll (http://www.dimastr.com/redemption)
+' which must be installed/registered in Windows, and referenced,
+' Tools> References...> SafeOutlook Library, in Outlook VBA.
+' : 7/13/2006 - DM: Removed dependecies to "Outlook redemption" library
+' Released as v1.0 by macros4outlook project
+'------------------------------------------------------------------------------------------
+
+Sub CheckMailText(ByVal Item As Object, Cancel As Boolean)
+ Dim bCancelSend As Boolean
+ Dim sTextToSearch As String
+ Dim sKeyWords As String
+ Dim vKeyWords() As String
+ Dim iStartOfQuote As Long
+ Dim iAttachmentCount As Long
+ Dim i As Long
+
+ If TypeName(Item) <> "MailItem" Then Exit Sub
+
+ 'Add keywords/phrases here. Use lowercase words in the following array.
+ sKeyWords = "attach;attached;attachment;enclosed;here's;here it is;anhang;angeh\xE4ngt;anlage;anbei"
+
+ 'CHECK FOR BLANK SUBJECT LINE
+ If Trim(Item.Subject) = "" Then
+ bCancelSend = MsgBox("This message does not have a subject." & vbNewLine & _
+ "Do you wish to continue sending anyway?", _
+ vbYesNo + vbExclamation, "No Subject") = vbNo
+ End If
+
+ 'CHECK BODY AND SUBJECT FOR ATTACMENT KEYWORDS.
+ 'Set TextToSearch variable to message Body based
+ 'on message type and find start of quoted text.
+ Select Case Item.BodyFormat
+ Case olFormatHTML
+ iStartOfQuote = InStr(Item.HTMLBody, "<DIV class=OutlookMessageHeader") - 1
+ sTextToSearch = Item.HTMLBody
+ Case olFormatRichText
+ iStartOfQuote = InStr(Item.Body, "_____________________________________________") - 1
+ sTextToSearch = Item.Body
+ Case olFormatPlain
+ iStartOfQuote = InStr(Item.Body, "-----Original Message-----") - 1
+ sTextToSearch = Item.Body
+ End Select
+ 'Adjust TextToSearch if there is quoted text
+ If iStartOfQuote > 0 Then sTextToSearch = Left(sTextToSearch, iStartOfQuote)
+ 'Add Subject to the search text if not a Reply
+ If Left(Item.Subject, 3) <> "RE:" Then
+ sTextToSearch = Item.Subject & " " & sTextToSearch
+ End If
+ 'Change to all lowercase for string comparison
+ sTextToSearch = LCase(sTextToSearch)
+ 'Replace undesired characters with spaces to help with ExactMatch function
+ sTextToSearch = Replace(sTextToSearch, ",", " ")
+ sTextToSearch = Replace(sTextToSearch, ".", " ")
+ sTextToSearch = Replace(sTextToSearch, "?", " ")
+ sTextToSearch = Replace(sTextToSearch, "!", " ")
+ sTextToSearch = Replace(sTextToSearch, Chr(34), " ") 'quotes
+ sTextToSearch = Replace(sTextToSearch, "<", " ") 'beginning of html tag
+ sTextToSearch = Replace(sTextToSearch, ">", " ") 'end of html tag
+ sTextToSearch = Replace(sTextToSearch, "&", " ") 'beginning of html Character Entities
+ sTextToSearch = Replace(sTextToSearch, ";", " ") 'end of html Character Entities
+
+ 'Start the search
+ If Not bCancelSend Then
+ iAttachmentCount = Item.Attachments.count 'DM: - EmbeddedAttachCount(Item)
+ If iAttachmentCount = 0 Then
+ vKeyWords = Split(sKeyWords, ";")
+ For i = LBound(vKeyWords) To UBound(vKeyWords)
+ If InStr(sTextToSearch, vKeyWords(i)) > 0 Then
+ If StrExactMatch(sTextToSearch, vKeyWords(i)) Then
+ bCancelSend = MsgBox("It appears you were going to send an attachment but nothing is attached." & vbNewLine & _
+ "Do you wish to continue sending anyway?" & vbNewLine & vbNewLine & _
+ "Word/Phrase found: " & vKeyWords(i), _
+ vbYesNo + vbExclamation, "Attachment Not Found") = vbNo
+ Exit For
+ End If
+ End If
+ Next i
+ End If
+ End If
+
+ 'Cancel sending message if answered yes to either message box.
+ Cancel = bCancelSend
+End Sub
+
+
+Private Function StrExactMatch(sLookIn As String, sLookFor As String) As Boolean
+ '- Add padding to sLookin in case sLookfor is at
+ ' the very beginning or very end of the sLookIn.
+ '- Add padding to sLookFor to ensure an exact match
+ StrExactMatch = (InStr(" " & sLookIn & " ", " " & sLookFor & " ") > 0) _
+ Or (InStr(sLookIn, vbCrLf & sLookFor & " ") > 0) _
+ Or (InStr(sLookIn, " " & sLookFor & vbCrLf) > 0) _
+ Or (InStr(sLookIn, vbCrLf & sLookFor & vbCrLf) > 0)
+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 17:32:16
|
Revision: 79
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=79&view=rev
Author: olly98
Date: 2011-04-22 17:32:10 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
preparing release
Modified Paths:
--------------
remindermacro/trunk/ReminderMacro.bas
Property Changed:
----------------
remindermacro/trunk/ReminderMacro.bas
Modified: remindermacro/trunk/ReminderMacro.bas
===================================================================
--- remindermacro/trunk/ReminderMacro.bas 2011-04-22 17:26:09 UTC (rev 78)
+++ remindermacro/trunk/ReminderMacro.bas 2011-04-22 17:32:10 UTC (rev 79)
@@ -1,4 +1,15 @@
Attribute VB_Name = "ReminderMacro"
+'$Id$
+'
+'Reminder Macro TRUNK
+'
+'Reminder Macro is part of the macros4outlook project
+'see https://sourceforge.net/apps/mediawiki/macros4outlook/index.php?title=Reminder_Macro or
+' http://sourceforge.net/projects/macros4outlook/ for more information
+'
+'For more information on Outlook see http://www.microsoft.com/outlook
+'Outlook is (C) by Microsoft
+
Option Explicit
'------------------------------------------------------------------------------------------
@@ -24,6 +35,7 @@
' which must be installed/registered in Windows, and referenced,
' Tools> References...> SafeOutlook Library, in Outlook VBA.
' : 7/13/2006 - DM: Removed dependecies to "Outlook redemption" library
+' Released as v1.0 by macros4outlook project
'------------------------------------------------------------------------------------------
Sub CheckMailText(ByVal Item As Object, Cancel As Boolean)
Property changes on: remindermacro/trunk/ReminderMacro.bas
___________________________________________________________________
Added: svn:keywords
+ 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 17:26:15
|
Revision: 78
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=78&view=rev
Author: olly98
Date: 2011-04-22 17:26:09 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
prepared release
Added Paths:
-----------
addcontactmacro/tags/
addcontactmacro/tags/1.0/
addcontactmacro/tags/1.0/AddContactMacro.bas
Copied: addcontactmacro/tags/1.0/AddContactMacro.bas (from rev 77, addcontactmacro/trunk/AddContactMacro.bas)
===================================================================
--- addcontactmacro/tags/1.0/AddContactMacro.bas (rev 0)
+++ addcontactmacro/tags/1.0/AddContactMacro.bas 2011-04-22 17:26:09 UTC (rev 78)
@@ -0,0 +1,102 @@
+Attribute VB_Name = "AddContactMacro"
+'$Id$
+'
+'Add Contact Macro 1.0
+'
+'Add Contact Macro is part of the macros4outlook project
+'see https://sourceforge.net/apps/mediawiki/macros4outlook/index.php?title=Add_Contact_Macro or
+' http://sourceforge.net/projects/macros4outlook/ for more information
+'
+'For more information on Outlook see http://www.microsoft.com/outlook
+'Outlook is (C) by Microsoft
+
+'****************************************************************************
+'License:
+'
+' sample Outlook 2003 VBA application by Sue Mosher
+' send questions/comments to web...@ou...
+' modified by dan...@us...
+'****************************************************************************
+
+'Changelog
+'
+'Version 1.0 - 2011-04-22
+' * first public relese
+
+Option Explicit
+
+
+Private Const AUTO_CONTACT_FOLDER_NAME As String = "AutoContacts"
+
+
+
+
+Public Sub AddRecipToContacts(ByVal MailItem As Object)
+ Dim strFind As String
+
+ Dim objNS As Outlook.NameSpace
+ Dim colContacts As Outlook.Items
+ Dim objContact As Outlook.ContactItem
+ Dim objRecip As Outlook.Recipient
+ Dim objContactFolder As MAPIFolder
+ Dim objNewContactFolder As MAPIFolder
+ Dim objMailItem As MailItem
+
+ Dim i As Integer
+
+
+ 'CAST
+ Set objMailItem = MailItem
+
+
+ ' get Contacts folder and its Items collection
+ Set objNS = Application.GetNamespace("MAPI")
+ Set objContactFolder = objNS.GetDefaultFolder(olFolderContacts)
+
+ On Error Resume Next 'to skip error if folder isn't in .Folders(...)!
+ 'see if autocontactfolder already exists
+ Set objNewContactFolder = objContactFolder.Folders(AUTO_CONTACT_FOLDER_NAME)
+ If (objNewContactFolder Is Nothing) Then 'error occured!
+ Set objNewContactFolder = objContactFolder.Folders.Add(AUTO_CONTACT_FOLDER_NAME)
+ End If
+ On Error GoTo 0
+
+
+ Set colContacts = objNewContactFolder.Items
+
+ ' process message recipients
+ For Each objRecip In objMailItem.Recipients
+ ' check to see if the recip is already in Contacts
+ For i = 1 To 3
+ strFind = "[Email" & i & "Address] = " & AddQuote(objRecip.Address)
+ Set objContact = colContacts.Find(strFind)
+ If Not objContact Is Nothing Then
+ 'MsgBox objRecip.Address & " already in addressbook!"
+ Exit For
+ End If
+ Next
+
+ ' if not, add it
+ If objContact Is Nothing Then
+ Set objContact = Application.CreateItem(olContactItem)
+ With objContact
+ .FullName = Replace(objRecip.Name, "'", "")
+ .Email1Address = objRecip.Address
+ .Save
+ .Move objNewContactFolder
+ End With
+ 'MsgBox "added " & objRecip.name & " to addressbook!"
+ End If
+ Set objContact = Nothing
+ Next
+
+ Set objNS = Nothing
+ Set objContact = Nothing
+ Set colContacts = Nothing
+ Set objContactFolder = Nothing
+ Set objNewContactFolder = Nothing
+End Sub
+
+Private Function AddQuote(MyText As String) As String
+ AddQuote = Chr(34) & MyText & Chr(34)
+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 17:25:20
|
Revision: 77
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=77&view=rev
Author: olly98
Date: 2011-04-22 17:25:14 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
prepared for release
Modified Paths:
--------------
addcontactmacro/trunk/AddContactMacro.bas
Modified: addcontactmacro/trunk/AddContactMacro.bas
===================================================================
--- addcontactmacro/trunk/AddContactMacro.bas 2011-04-22 17:02:38 UTC (rev 76)
+++ addcontactmacro/trunk/AddContactMacro.bas 2011-04-22 17:25:14 UTC (rev 77)
@@ -20,6 +20,9 @@
'Changelog
'
+'Version 1.0 - 2011-04-22
+' * first public relese
+'
'$Revision$ - not released
Option Explicit
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-22 16:38:20
|
Revision: 74
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=74&view=rev
Author: olly98
Date: 2011-04-22 16:38:15 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
preparing release
Modified Paths:
--------------
quotefixmacro/trunk/QuoteColorizerMacro.bas
quotefixmacro/trunk/QuoteFixMacro.bas
quotefixmacro/trunk/SoftWrapMacro.bas
Modified: quotefixmacro/trunk/QuoteColorizerMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteColorizerMacro.bas 2011-04-22 16:26:40 UTC (rev 73)
+++ quotefixmacro/trunk/QuoteColorizerMacro.bas 2011-04-22 16:38:15 UTC (rev 74)
@@ -28,6 +28,9 @@
'Changelog
'
+'Version 1.0 - 2011-04-22
+' * first public relese
+'
'$Revision$ - not released
Option Explicit
Modified: quotefixmacro/trunk/QuoteFixMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 16:26:40 UTC (rev 73)
+++ quotefixmacro/trunk/QuoteFixMacro.bas 2011-04-22 16:38:15 UTC (rev 74)
@@ -64,7 +64,7 @@
'Version 1.2b - 2007-01-24
' * included on-behalf-of handling written by Per Soderlind (per [at] soderlind [dot] no)
'
-'$Revision$ - not released
+'Version 1.3 - 2011-04-22
' * included %C patch 2778722 by Karsten Heimrich
' * included %SE patch 2807638 by Peter Lindgren
' * check for beginning of quote is now language independent
@@ -86,6 +86,8 @@
' * 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"
+'
+'$Revision$ - not released
'Ideas were taken from
' * Daniele Bochicchio
Modified: quotefixmacro/trunk/SoftWrapMacro.bas
===================================================================
--- quotefixmacro/trunk/SoftWrapMacro.bas 2011-04-22 16:26:40 UTC (rev 73)
+++ quotefixmacro/trunk/SoftWrapMacro.bas 2011-04-22 16:38:15 UTC (rev 74)
@@ -27,6 +27,9 @@
'Changelog
'
+'Version 1.0 - 2011-04-22
+' * first public relese
+'
'$Revision$ - not released
Option Explicit
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:12:53
|
Revision: 72
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=72&view=rev
Author: olly98
Date: 2011-04-22 16:12:47 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
trying to get par running. Currently par does not provide the expected output.
Added Paths:
-----------
parquotefixmacro/branches/
parquotefixmacro/branches/noclipboard/
parquotefixmacro/branches/noclipboard/QuoteFixWithPAR.bas
Copied: parquotefixmacro/branches/noclipboard/QuoteFixWithPAR.bas (from rev 69, parquotefixmacro/trunk/QuoteFixWithPAR.bas)
===================================================================
--- parquotefixmacro/branches/noclipboard/QuoteFixWithPAR.bas (rev 0)
+++ parquotefixmacro/branches/noclipboard/QuoteFixWithPAR.bas 2011-04-22 16:12:47 UTC (rev 72)
@@ -0,0 +1,212 @@
+Attribute VB_Name = "QuoteFixWithPAR"
+'$Id$
+'
+'QuoteFix with PAR - branch "no clipboard"
+'
+'QuoteFix with PAR is part of the macros4outlook project
+'see http://sourceforge.net/projects/macros4outlook/ for more information
+'
+'For more information on Outlook see http://www.microsoft.com/outlook
+'Outlook is (C) by Microsoft
+
+'****************************************************************************
+'License:
+'
+'QuoteFix with PAR
+' copyright 2008-2009 Daniel Martin. All rights reserved.
+' copyright 2011 Oliver Kopp. All rights reserved.
+'
+'
+'Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+'
+' 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+' 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+' 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission.
+'
+'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+'****************************************************************************
+
+'Changelog
+'
+'$Revision$ - not released
+' * Removed dependency on clipboard. Currently, par does not work with certain quotes (see Tools.bas).
+
+Option Explicit
+
+Private Const PAR_OPTIONS As String = "75q" 'DEFAULT=rTbgqR B=.,?_A_a Q=_s>|
+Private Const PAR_CMD As String = "C:\cygwin\bin\bash.exe --login -c 'export PARINIT=""rTbgq B=.,?_A_a Q=_s>|"" ; par " & PAR_OPTIONS & "'"
+
+'Automatically convert HTML/RTF-Mails to plain text?
+Private Const CONVERT_TO_PLAIN As Boolean = False
+
+Private Enum ReplyType
+ TypeReply = 1
+ TypeReplyAll = 2
+ TypeForward = 3
+End Enum
+
+Function ExecPar(mailtext As String) As String
+ Dim ret As String
+ Dim line As String
+
+ Dim shell As Object
+ Dim pipe As Object
+ Set shell = CreateObject("WScript.Shell")
+
+ Debug.Print PAR_CMD
+ Set pipe = shell.Exec(PAR_CMD)
+ Debug.Print "END PAR"
+
+ pipe.StdIn.Write (mailtext)
+ pipe.StdIn.Close
+
+ 'Debug.Print "READING..."
+ While (pipe.StdOut.AtEndOfStream = False)
+ line = pipe.StdOut.ReadLine()
+ If (Left(line, 1) = ">") Then
+ ret = ret & ">" & line & vbCrLf
+ Else
+ ret = ret & "> " & line & vbCrLf
+ End If
+ Wend
+ ret = pipe.StdOut.ReadAll()
+ 'Debug.Print ret
+
+ Set pipe = Nothing
+ Set shell = Nothing
+
+ ExecPar = ret
+End Function
+
+
+
+Private Sub FixMailText(SelectedObject As Object, MailMode As ReplyType)
+ Dim TempObj As Object
+
+ 'we only understand mail items, no PostItems, NoteItems, ...
+ If Not (TypeName(SelectedObject) = "MailItem") Then
+ On Error GoTo catch: 'try, catch replacement
+ Dim HadError As Boolean
+ HadError = True
+
+ Select Case MailMode
+ Case TypeReply:
+ Set TempObj = SelectedObject.reply
+ TempObj.Display
+ HadError = False
+ Exit Sub
+ Case TypeReplyAll:
+ Set TempObj = SelectedObject.ReplyAll
+ TempObj.Display
+ HadError = False
+ Exit Sub
+ Case TypeForward:
+ Set TempObj = SelectedObject.Forward
+ TempObj.Display
+ HadError = False
+ Exit Sub
+ End Select
+
+catch:
+ On Error GoTo 0 'deactivate errorhandling
+
+ If (HadError = True) Then
+ 'reply / replyall / forward caused error
+ ' --> just display it
+ SelectedObject.Display
+ Exit Sub
+ End If
+ End If
+
+ Dim OriginalMail As MailItem
+ Set OriginalMail = SelectedObject 'cast!!!
+
+
+ 'mails that have not been sent can\xB4t be replied to (draft mails)
+ If Not OriginalMail.Sent Then
+ MsgBox "This mail seems to be a draft, so it cannot be replied to.", vbExclamation
+ Exit Sub
+ End If
+
+ 'we don\xB4t understand HTML mails!!!
+ If Not (OriginalMail.BodyFormat = olFormatPlain) Then
+ If CONVERT_TO_PLAIN Then
+ 'Unfortunately, it\xB4s only possible to convert the original mail as there is
+ 'no easy way to create a clone. Therefore, you cannot go back to the original format!
+ 'If you e.g. would decide that you need to forward the mail in HTML format,
+ 'this will not be possible anymore.
+ SelectedObject.BodyFormat = olFormatPlain
+ Else
+ Dim ReplyObj As MailItem
+
+ Select Case MailMode
+ Case TypeReply:
+ Set ReplyObj = OriginalMail.reply
+ Case TypeReplyAll:
+ Set ReplyObj = OriginalMail.ReplyAll
+ Case TypeForward:
+ Set ReplyObj = OriginalMail.Forward
+ End Select
+
+ ReplyObj.Display
+ Exit Sub
+ End If
+ End If
+
+ 'create reply --> outlook style!
+ Dim NewMail As MailItem
+ Select Case MailMode
+ Case TypeReply:
+ Set NewMail = OriginalMail.reply
+ Case TypeReplyAll:
+ Set NewMail = OriginalMail.ReplyAll
+ Case TypeForward:
+ Set NewMail = OriginalMail.Forward
+ End Select
+
+ 'if the mail is marked as a possible phishing mail, a warning will be shown and
+ 'the reply methods will return null (forward method is ok)
+ If NewMail Is Nothing Then Exit Sub
+
+ 'put the whole mail as composed by Outlook into an array
+ Dim BodyLines() As String
+ BodyLines = Split(NewMail.Body, vbCrLf)
+
+ 'reformat
+ Dim text As String
+ text = NewMail.Body
+ Debug.Print "BEFORE PAR: " & vbCrLf & text
+ text = ExecPar(text)
+ Debug.Print "AFTER PAR: " & vbCrLf & text
+ NewMail.Body = text
+
+ NewMail.Display
+
+ 'mark original mail as read
+ OriginalMail.UnRead = False
+End Sub
+
+'these are the macros called by the custom buttons
+Sub FixedReply()
+ Dim m As Object
+ Set m = GetCurrentItem()
+
+ Call FixMailText(m, TypeReply)
+End Sub
+
+
+Sub FixedReplyAll()
+ Dim m As Object
+ Set m = GetCurrentItem()
+
+ Call FixMailText(m, TypeReplyAll)
+End Sub
+
+
+Sub FixedForward()
+ Dim m As Object
+ Set m = GetCurrentItem()
+
+ Call FixMailText(m, TypeForward)
+End Sub
+
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:08:53
|
Revision: 71
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=71&view=rev
Author: olly98
Date: 2011-04-22 16:08:46 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
some more par tests
Modified Paths:
--------------
testing/Tools.bas
Modified: testing/Tools.bas
===================================================================
--- testing/Tools.bas 2011-04-22 15:09:42 UTC (rev 70)
+++ testing/Tools.bas 2011-04-22 16:08:46 UTC (rev 71)
@@ -89,7 +89,7 @@
Public Sub TestPar()
- Dim s As String
+ Dim s, s2 As String
Dim ret As String
Dim cmd As String
@@ -97,15 +97,42 @@
Dim pipe As Object
Set shell = CreateObject("WScript.Shell")
+' s = "test daniel 23e " & vbCrLf & _
+' "> asd asd sad " & vbCrLf & _
+' "> sad asdad as " & vbCrLf & _
+' ">> sa asddsa asd aas kj kj kj k jlkjhlkjhsda asdf asdf adsf as df asdf ads fa dsfa dsf " & vbCrLf & _
+' ">> aasd asdaasdf asd fasdf asd f asd fa sdf adsf asdf saas " & vbCrLf & _
+' "> sasad asda sasd asd asd asd asd aasdf asdf as df asdf a sd f asd f as df asd fasdf a sdf asdf sdasdasd "
+
+ 'par does not work as expected
+ ' --> par combines all the lines together and seems to completely ignore the quoting characters
s = "test daniel 23e " & vbCrLf & _
"> asd asd sad " & vbCrLf & _
"> sad asdad as " & vbCrLf & _
- ">> sa asddsa asd aas kj kj kj k jlkjhlkjhsda asdf asdf adsf as df asdf ads fa dsfa dsf " & vbCrLf & _
- ">> aasd asdaasdf asd fasdf asd f asd fa sdf adsf asdf saas " & vbCrLf & _
- "> sasad asda sasd asd asd asd asd aasdf asdf as df asdf a sd f asd f as df asd fasdf a sdf asdf sdasdasd "
+ "> > sa asddsa asd aas kj kj kj k jlkjhlkjhsda asdf asdf adsf as df asdf ads fa dsfa dsf " & vbCrLf & _
+ "> > aasd asdaasdf asd fasdf asd f asd fa sdf adsf asdf saas " & vbCrLf & _
+ "> Nur mit einem Quote " & vbCrLf & _
+ "Testtext."
+
+ 'From the manual of par
+ 'Result is fine
+ s2 = "Joe Public writes:" & vbCrLf & _
+ "> Jane Doe writes:" & vbCrLf & _
+ "> >" & vbCrLf & _
+ "> >" & vbCrLf & _
+ "> > I can't find the source for uncompress." & vbCrLf & _
+ "> Oh no, not again!!!" & vbCrLf & _
+ ">" & vbCrLf & _
+ ">" & vbCrLf & _
+ "> Isn't there a FAQ for this?" & vbCrLf & _
+ ">" & vbCrLf & _
+ ">" & vbCrLf & _
+ "That wasn 't very helpful, Joe. Jane," & vbCrLf & _
+ "just make a link from uncompress to compress."
+
+ cmd = "C:\cygwin\bin\bash.exe --login -c 'export PARINIT=""rTbgqR B=.,?_A_a Q=_s>|"" ; par 60q'"
+ 'cmd = "C:\cygwin\bin\bash.exe --login -c 'par 60q'"
- cmd = "C:\Programme\cygwin\bin\bash.exe --login -c 'export PARINIT=""rTbgqR B=.,?_A_a Q=_s>|"" ; par 60q'"
-
Debug.Print cmd
Set pipe = shell.Exec(cmd)
Debug.Print "END PAR"
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 14:26:10
|
Revision: 69
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=69&view=rev
Author: olly98
Date: 2011-04-22 14:26:04 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
added header, made small configuration changes
Modified Paths:
--------------
parquotefixmacro/trunk/QuoteFixWithPAR.bas
Property Changed:
----------------
parquotefixmacro/trunk/QuoteFixWithPAR.bas
Modified: parquotefixmacro/trunk/QuoteFixWithPAR.bas
===================================================================
--- parquotefixmacro/trunk/QuoteFixWithPAR.bas 2011-04-22 13:55:43 UTC (rev 68)
+++ parquotefixmacro/trunk/QuoteFixWithPAR.bas 2011-04-22 14:26:04 UTC (rev 69)
@@ -1,11 +1,39 @@
Attribute VB_Name = "QuoteFixWithPAR"
+'$Id$
+'
+'QuoteFix with PAR TRUNK
+'
+'QuoteFix with PAR is part of the macros4outlook project
+'see http://sourceforge.net/projects/macros4outlook/ for more information
+'
+'For more information on Outlook see http://www.microsoft.com/outlook
+'Outlook is (C) by Microsoft
+
+'****************************************************************************
+'License:
+'
+'QuoteFix with PAR
+' copyright 2008-2009 Daniel Martin. All rights reserved.
+'
+'
+'Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+'
+' 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+' 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+' 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission.
+'
+'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+'****************************************************************************
+
+'Changelog
+'
+'$Revision$ - not released
+
Option Explicit
Private Const PAR_OPTIONS As String = "75q" 'DEFAULT=rTbgqR B=.,?_A_a Q=_s>|
-Private Const PAR_CMD As String = "C:\Programme\cygwin\bin\bash.exe --login -c 'export PARINIT=""rTbgq B=.,?_A_a Q=_s>|"" ; par " & PAR_OPTIONS & "'"
+Private Const PAR_CMD As String = "C:\cygwin\bin\bash.exe --login -c 'export PARINIT=""rTbgq B=.,?_A_a Q=_s>|"" ; par " & PAR_OPTIONS & "'"
-Public Const ENABLE_MACRO_PAR_QUOTEFIX As Boolean = True
-
' clipboard interaction in win32
' Provided by Allen Browne, al...@al...
Declare Function abOpenClipboard Lib "User32" Alias "OpenClipboard" (ByVal Hwnd As Long) As Long
@@ -67,7 +95,6 @@
'copy selection to clipboard
SendKeys "^c", True 'ctrl-c, wait until done
-
'get text from clipboard
ret = Clipboard2Text
If (IsNull(ret)) Then Exit Sub 'error or no text in clipboard
Property changes on: parquotefixmacro/trunk/QuoteFixWithPAR.bas
___________________________________________________________________
Added: svn:keywords
+ 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 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 13:54:25
|
Revision: 67
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=67&view=rev
Author: olly98
Date: 2011-04-22 13:54:19 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
fixed header, added history
Modified Paths:
--------------
quotefixmacro/trunk/QuoteColorizerMacro.bas
Property Changed:
----------------
quotefixmacro/trunk/QuoteColorizerMacro.bas
Modified: quotefixmacro/trunk/QuoteColorizerMacro.bas
===================================================================
--- quotefixmacro/trunk/QuoteColorizerMacro.bas 2011-04-22 13:53:19 UTC (rev 66)
+++ quotefixmacro/trunk/QuoteColorizerMacro.bas 2011-04-22 13:54:19 UTC (rev 67)
@@ -1,10 +1,11 @@
Attribute VB_Name = "QuoteColorizerMacro"
'$Id$
'
-'QuoteColorizerMacro TRUNK
+'Quote Colorizer Macro TRUNK
'
-'QuoteColorizerMacro is part of the macros4outlook project
-'see http://sourceforge.net/projects/macros4outlook/ for more information
+'Quote Colorizer Macro is part of the macros4outlook project
+'see http://sourceforge.net/apps/mediawiki/macros4outlook/index.php?title=Quote_Colorizer_Macro or
+' http://sourceforge.net/projects/macros4outlook/ for more information
'
'For more information on Outlook see http://www.microsoft.com/outlook
'Outlook is (C) by Microsoft
@@ -25,6 +26,9 @@
'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
'****************************************************************************
+'Changelog
+'
+'$Revision$ - not released
Option Explicit
@@ -77,7 +81,7 @@
rtf = Trim(rtf) 'kill unnecessary spaces (from rtf var init with Space(rtf))
Debug.Print rtf & vbCrLf & "*************************************************************" & vbCrLf
- 'we have out own rtf haeder, remove generated one
+ 'we have our own rtf haeder, remove generated one
Dim PosHeaderEnd As Integer
Dim sTestString As String
PosHeaderEnd = InStr(rtf, "\uc1\pard\plain\deftab360")
@@ -141,7 +145,7 @@
End If
- 'dereference all objects! otherwise, rtf isnt going to be updated!
+ 'dereference all objects! otherwise, rtf isn't going to be updated!
Set folder = Nothing
'save return value
ColorizeMailItem = MyMailItem.EntryID
Property changes on: quotefixmacro/trunk/QuoteColorizerMacro.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 13:53:26
|
Revision: 66
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=66&view=rev
Author: olly98
Date: 2011-04-22 13:53:19 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
added test for GetNames()
Modified Paths:
--------------
quotefixmacro/trunk/TestCases_GetNames.bas
Property Changed:
----------------
quotefixmacro/trunk/TestCases_GetNames.bas
Modified: quotefixmacro/trunk/TestCases_GetNames.bas
===================================================================
--- quotefixmacro/trunk/TestCases_GetNames.bas 2011-04-22 13:45:24 UTC (rev 65)
+++ quotefixmacro/trunk/TestCases_GetNames.bas 2011-04-22 13:53:19 UTC (rev 66)
@@ -10,8 +10,8 @@
'****************************************************************************
'License:
'
-'QuoteFixMacro testcases
-' copyright 2009 Lars Monsees. All rights reserved.
+'QuoteFixMacro testcases for getNames sub
+' copyright 2011 Oliver Kopp and Lars Monsees. All rights reserved.
'
'
'Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
@@ -23,19 +23,16 @@
'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
'****************************************************************************
-'This module defines some test cases that can be run to test if the quotefix macros
-'return the expected results.
+'Changelog
'
-'Required settings:
-'USE_COLORIZER unset
-'INCLUDE_QUOTES_TO_LEVEL = -1
-'LINE_WRAP_AFTER = 75
-'
+'$Revision$ - not released
+
Option Explicit
Private Type typeTestCase
- OutlookOutput As String
- ExpectedResult As String
+ originalName As String
+ ExpectedFirstName As String
+ ExpectedSenderName As String
End Type
Private mTestCases() As typeTestCase
@@ -43,163 +40,121 @@
ReDim Preserve mTestCases(UBound(mTestCases) + 1)
mTestCases(UBound(mTestCases)) = testcase
-
End Sub
-'Helper function to compare the results and find differences
-Private Sub compareResults(ByVal sProcessedMail As String, ByVal sExpectedResult As String)
-
- Dim i As Long
- Dim bExtraenousChars As Boolean
- Dim char1 As String
- Dim char2 As String
-
-
- If True Then
- Debug.Print "Expected Result"
- Debug.Print sExpectedResult
- Debug.Print "Processed Mail"
- Debug.Print sProcessedMail
- For i = 1 To Len(sProcessedMail)
- If i > Len(sExpectedResult) Then
- 'output is longer than expected result
- 'print out extraenous chars
- Debug.Print mid$(sProcessedMail, i)
- bExtraenousChars = True
- Else
- char1 = mid$(sProcessedMail, i, 1)
- char2 = mid$(sExpectedResult, i, 1)
-
- If Not char1 = char2 Then
- Debug.Print "Position: " + CStr(i)
- Debug.Print "Processed: " + char1 + ", " + CStr(Asc(char1))
- Debug.Print "Expected: " + char2 + ", " + CStr(Asc(char2))
- End If
- End If
- Next i
- End If
-
- Debug.Assert Not bExtraenousChars
- Debug.Assert False
-
-End Sub
-
'Puts all test cases into the passed array.
-'Text has to be formatted as it is returned by Outlook.
Private Sub initTestCases()
Dim testcase As typeTestCase
-
ReDim mTestCases(0)
- 'add dummy entry
+ 'dummy - will never be called as testcases are called from 1 on
+ ' Alternative: Use "Option Base 1" and add first testcase by a direct assignment and not by addTestCaseToArray
mTestCases(0) = testcase
- testcase.OutlookOutput = "" + _
- "> >>" + vbNewLine + _
- "> >> I have a Win 2k3 SBS and I want to replicate the users into my" + vbNewLine + _
- "> OpenLDAP" + vbNewLine + _
- "> >> 2.4.11." + vbNewLine + _
- "> >" + vbNewLine + _
- "> > This is not possible. You could however implement your own sync" + vbNewLine + _
- "> process" + vbNewLine + _
- "> > in your favourite scripting/programming language." + vbNewLine + _
- "> " + vbNewLine + _
- "> Actually we have done some preliminary work..."
- testcase.ExpectedResult = "" + _
- ">>> " + vbNewLine + _
- ">>> I have a Win 2k3 SBS and I want to replicate the users into my" + vbNewLine + _
- ">>> OpenLDAP 2.4.11." + vbNewLine + _
- ">> " + vbNewLine + _
- ">> This is not possible. You could however implement your own sync process" + vbNewLine + _
- ">> in your favourite scripting/programming language." + vbNewLine + _
- "> " + vbNewLine + _
- "> Actually we have done some preliminary work..."
+ testcase.originalName = "First Last"
+ testcase.ExpectedFirstName = "First"
+ testcase.ExpectedSenderName = "First Last"
Call addTestCaseToArray(testcase)
-
- testcase.OutlookOutput = "" + _
- "> Moin," + vbNewLine + _
- "> " + vbNewLine + _
- "> Kurzanleitung """"Deckel \xF6ffnen"""":" + vbNewLine + _
- "> 1. Unten rechts die Kunststoff-Abdeckung mit einem Schraubendreher" + vbNewLine + _
- "> nach rechts schieben." + vbNewLine + _
- "> 2. Das Blech nach links schieben." + vbNewLine + _
- "> 3. Kreuzschlitzschraube l\xF6sen." + vbNewLine + _
- "> " + vbNewLine + _
- "> " + vbNewLine + _
- "> Mit freundlichen Gr\xFC\xDFen" + vbNewLine + _
- "> " + vbNewLine + _
- "> company" + vbNewLine + _
- "> Jon Doe"
- testcase.ExpectedResult = testcase.OutlookOutput
+ testcase.originalName = "Last, First"
+ testcase.ExpectedFirstName = "First"
+ testcase.ExpectedSenderName = testcase.originalName
Call addTestCaseToArray(testcase)
-
-
- 'This testcase currently does not run through
- 'The algorithm has to be adapted not to requote greetings
- testcase.OutlookOutput = "" + _
- "> Hallo Jon, ich hatte mal von xxxxxx ein Anti-Virus Programm, aber ich" + vbNewLine + _
- "> habe" + vbNewLine + _
- "> so viele Spams trotzdem erhalten, dass ich das nicht mehr abonniert" + vbNewLine + _
- "> habe." + vbNewLine + _
- "> xxx xxxxx? Haste eine L\xF6sung f\xFCr mein Virenprogramm, kann ich was" + vbNewLine + _
- "> runterladen?" + vbNewLine + _
- "> Lieben Gru\xDF Jane"
- testcase.ExpectedResult = "" + _
- "> Hallo Jon, ich hatte mal von xxxxxx ein Anti-Virus Programm, aber ich" + vbNewLine + _
- "> habe so viele Spams trotzdem erhalten, dass ich das nicht mehr abonniert" + vbNewLine + _
- "> habe. xxx xxxxx? Haste eine L\xF6sung f\xFCr mein Virenprogramm, kann" + vbNewLine + _
- "> ich was runterladen?" + vbNewLine + _
- "> Lieben Gru\xDF Jane"
+
+ testcase.originalName = "First Middle Last"
+ testcase.ExpectedFirstName = "First"
+ testcase.ExpectedSenderName = testcase.originalName
Call addTestCaseToArray(testcase)
-End Sub
-
-'Runs a single test case
-Private Function runTestCase(ByRef testcase As typeTestCase) As Boolean
+ testcase.originalName = "fi...@ex..."
+ testcase.ExpectedFirstName = "First"
+ testcase.ExpectedSenderName = testcase.originalName
+ Call addTestCaseToArray(testcase)
- Dim processedMail As String
+ testcase.originalName = "fir...@ex..."
+ testcase.ExpectedFirstName = "First"
+ testcase.ExpectedSenderName = testcase.originalName
+ Call addTestCaseToArray(testcase)
+ testcase.originalName = "Dr. First Last"
+ testcase.ExpectedFirstName = "First"
+ testcase.ExpectedSenderName = testcase.originalName
+ Call addTestCaseToArray(testcase)
- 'pass original mail to quotefix function
- processedMail = QuoteFixMacro.ReFormatText(testcase.OutlookOutput)
+' testcase.OriginalName = ""
+' testcase.ExpectedFirstName = ""
+' testcase.ExpectedSenderName = testcase.originalName
+' Call addTestCaseToArray(testcase)
- 'return result
- runTestCase = (processedMail = testcase.ExpectedResult)
+End Sub
+
+'Runs a single test case
+Private Function runTestCase(ByRef testcase As typeTestCase, ByRef curNum As Integer) As Boolean
+ Dim firstName As String
+ Dim senderName As String
+ Call getNamesOutOfString(testcase.originalName, senderName, firstName)
- 'compare results to find differences (perhaps a better way would be to use WinMerge)
- If Not runTestCase Then
- Call compareResults(processedMail, testcase.ExpectedResult)
- End If
+ Dim firstNameDiffers As Boolean
+ Dim senderNameDiffers As Boolean
+ firstNameDiffers = (testcase.ExpectedFirstName <> firstName)
+ senderNameDiffers = (testcase.ExpectedSenderName <> senderName)
+ If firstNameDiffers Or senderNameDiffers Then
+ Debug.Print "TestCase " + CStr(curNum) + " failed:"
+
+ Dim fiS As String
+ If firstNameDiffers Then
+ fiS = " <> "
+ Else
+ fiS = " = "
+ End If
+
+ Dim srS As String
+ If senderNameDiffers Then
+ srS = " <> "
+ Else
+ srS = " = "
+ End If
+
+ Debug.Print testcase.originalName + ":"
+ Debug.Print firstName + fiS + testcase.ExpectedFirstName
+ Debug.Print senderName + srS + testcase.ExpectedSenderName
+ Debug.Print
+
+ 'MsgBox "TestCase " + CStr(curNum) + " failed", vbExclamation
+ runTestCase = False
+ Else
+ runTestCase = True
+ End If
End Function
-Public Function runTestCaseNo(ByVal nIndex As Integer) As Boolean
-
+Public Sub runTestCaseNo_GetNames(ByVal nIndex As Integer)
Call initTestCases
- If nIndex >= LBound(mTestCases) And nIndex <= UBound(mTestCases) Then
- runTestCaseNo = runTestCase(mTestCases(nIndex))
+ ' Array runs from 0 to UBound, but we use entries from 1 to UBound
+ If nIndex >= 1 And nIndex <= UBound(mTestCases) Then
+ Call runTestCase(mTestCases(nIndex), nIndex)
End If
-
-End Function
+End Sub
-Public Sub runTests_ReformatText()
-
+Public Sub runTests_GetNames()
Dim i As Integer
-
Call initTestCases
- For i = 0 To UBound(mTestCases)
- If Not runTestCase(mTestCases(i)) Then
- MsgBox "TestCase " + CStr(i) + " failed", vbExclamation
- End If
+ Dim allSuccessful As Boolean
+ allSuccessful = True
+
+ For i = 1 To UBound(mTestCases)
+ allSuccessful = allSuccessful And runTestCase(mTestCases(i), i)
Next i
-
+
+ If Not allSuccessful Then
+ MsgBox "At least one testcase failed. See debug output for details", vbExclamation
+ End If
End Sub
Property changes on: quotefixmacro/trunk/TestCases_GetNames.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 13:45:33
|
Revision: 65
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=65&view=rev
Author: olly98
Date: 2011-04-22 13:45:24 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
added version history
Modified Paths:
--------------
quotefixmacro/trunk/TestCases_ReFormatText.bas
Property Changed:
----------------
quotefixmacro/trunk/TestCases_ReFormatText.bas
Modified: quotefixmacro/trunk/TestCases_ReFormatText.bas
===================================================================
--- quotefixmacro/trunk/TestCases_ReFormatText.bas 2011-04-22 13:40:52 UTC (rev 64)
+++ quotefixmacro/trunk/TestCases_ReFormatText.bas 2011-04-22 13:45:24 UTC (rev 65)
@@ -1,7 +1,15 @@
Attribute VB_Name = "TestCases_ReFormatText"
'$Id$
'
-'These test cases part of the macros4outlook project
+'This module defines test cases that can be run to test if the quotefix macros
+'return the expected results.
+'
+'Required settings:
+'USE_COLORIZER unset
+'INCLUDE_QUOTES_TO_LEVEL = -1
+'LINE_WRAP_AFTER = 75
+'
+'These test cases are part of the macros4outlook project
'see http://sourceforge.net/projects/macros4outlook/ for more information
'
'For more information on Outlook see http://www.microsoft.com/outlook
@@ -23,14 +31,10 @@
'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
'****************************************************************************
-'This module defines some test cases that can be run to test if the quotefix macros
-'return the expected results.
+'Changelog
'
-'Required settings:
-'USE_COLORIZER unset
-'INCLUDE_QUOTES_TO_LEVEL = -1
-'LINE_WRAP_AFTER = 75
-'
+'$Revision$ - not released
+
Option Explicit
Private Type typeTestCase
Property changes on: quotefixmacro/trunk/TestCases_ReFormatText.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 13:40:58
|
Revision: 64
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=64&view=rev
Author: olly98
Date: 2011-04-22 13:40:52 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
moved Tools.bas to testing/ -- Tools is not needed for execution of any macro
Added Paths:
-----------
testing/
testing/Tools.bas
Removed Paths:
-------------
quotefixmacro/trunk/Tools.bas
Deleted: quotefixmacro/trunk/Tools.bas
===================================================================
--- quotefixmacro/trunk/Tools.bas 2011-04-22 13:35:26 UTC (rev 63)
+++ quotefixmacro/trunk/Tools.bas 2011-04-22 13:40:52 UTC (rev 64)
@@ -1,122 +0,0 @@
-Attribute VB_Name = "Tools"
-'$Id: QuoteFixMacro.bas 57 2011-03-14 15:02:18Z larsen255 $
-'
-'QuoteColorizerMacro TRUNK
-'
-'QuoteColorizerMacro is part of the macros4outlook project
-'see http://sourceforge.net/projects/macros4outlook/ for more information
-'
-'For more information on Outlook see http://www.microsoft.com/outlook
-'Outlook is (C) by Microsoft
-
-'****************************************************************************
-'License:
-'
-'QuoteColorizerMacro
-' copyright 2006-2009 Daniel Martin. All rights reserved.
-'
-'
-'Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
-'
-' 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
-' 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
-' 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission.
-'
-'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-'****************************************************************************
-
-Option Explicit
-
-Global InterceptorCollection As New Collection
-
-
-
-
-Public Sub MarkMailAsUnread(MyMail As MailItem)
- MyMail.UnRead = True
-End Sub
-
-Public Sub ReadCurrentMailItemRTF()
- Dim rtf As String, ret As Integer
- rtf = Space(99999)
- ret = ReadRTF("MAPI", GetCurrentItem.EntryID, Session.GetDefaultFolder(olFolderInbox).StoreID, rtf)
- rtf = Trim(rtf)
-
- Debug.Print "RTF READ:" & ret & vbCrLf & rtf
-End Sub
-
-Public Sub TestColors()
- Dim mi As MailItem
- 'Set mi = Session.GetDefaultFolder(olFolderInbox).Items(99)
- Set mi = GetCurrentItem()
- 'mi.Display
-
- Dim answer As MailItem
- Set answer = mi.reply
- Set mi = Nothing
-
- answer.BodyFormat = olFormatRichText
-
- Dim mid As String
- 'mid = QuoteColorizerMacro.ColorizeMailItem(answer)
- answer.Display
- Set answer = Nothing 'answer bodyformat changes here to 1 for some stupid reason...
-
- 'Call Tools.DisplayMailItemByID(mid)
-End Sub
-
-
-Public Sub FranksMacro(CurrentItem As MailItem)
- 'put mails with me as the ONLY recipient into one folder, all others into another
-
- 'declare mapifolders to move to here...
-
-
- If (CurrentItem.Recipients.count > 1) Then
- 'put into "uninteresting" folder...
- 'CurrentItem.Move(...)
- Else
- 'put into "interesting" folder
- 'CurrentItem.Move
- End If
-
-End Sub
-
-
-Public Sub TestPar()
- Dim s As String
- Dim ret As String
- Dim cmd As String
-
- Dim shell As Object
- Dim pipe As Object
- Set shell = CreateObject("WScript.Shell")
-
- s = "test daniel 23e " & vbCrLf & _
- "> asd asd sad " & vbCrLf & _
- "> sad asdad as " & vbCrLf & _
- ">> sa asddsa asd aas kj kj kj k jlkjhlkjhsda asdf asdf adsf as df asdf ads fa dsfa dsf " & vbCrLf & _
- ">> aasd asdaasdf asd fasdf asd f asd fa sdf adsf asdf saas " & vbCrLf & _
- "> sasad asda sasd asd asd asd asd aasdf asdf as df asdf a sd f asd f as df asd fasdf a sdf asdf sdasdasd "
-
- cmd = "C:\Programme\cygwin\bin\bash.exe --login -c 'export PARINIT=""rTbgqR B=.,?_A_a Q=_s>|"" ; par 60q'"
-
- Debug.Print cmd
- Set pipe = shell.Exec(cmd)
- Debug.Print "END PAR"
-
- pipe.StdIn.Write (s)
- pipe.StdIn.Close
-
-
- Debug.Print "READING..."
- 'While (pipe.StdOut.AtEndOfStream = False)
- ' ret = ret + pipe.StdOut.ReadLine() + vbCrLf
- 'Wend
- ret = pipe.StdOut.ReadAll()
- Debug.Print ret
-
- Set pipe = Nothing
- Set shell = Nothing
-End Sub
-
Copied: testing/Tools.bas (from rev 58, quotefixmacro/trunk/Tools.bas)
===================================================================
--- testing/Tools.bas (rev 0)
+++ testing/Tools.bas 2011-04-22 13:40:52 UTC (rev 64)
@@ -0,0 +1,127 @@
+Attribute VB_Name = "Tools"
+'$Id$
+'
+'Tools TRUNK
+'contains test routines
+'
+'Tools is part of the macros4outlook project
+'see http://sourceforge.net/projects/macros4outlook/ for more information
+'
+'For more information on Outlook see http://www.microsoft.com/outlook
+'Outlook is (C) by Microsoft
+
+'****************************************************************************
+'License:
+'
+'Tools
+' copyright 2006-2009 Daniel Martin. All rights reserved.
+'
+'
+'Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+'
+' 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+' 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+' 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission.
+'
+'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+'****************************************************************************
+
+'Changelog
+'
+'$Revision$ - not released
+
+Option Explicit
+
+Global InterceptorCollection As New Collection
+
+
+
+
+Public Sub MarkMailAsUnread(MyMail As MailItem)
+ MyMail.UnRead = True
+End Sub
+
+Public Sub ReadCurrentMailItemRTF()
+ Dim rtf As String, ret As Integer
+ rtf = Space(99999)
+ ret = ReadRTF("MAPI", GetCurrentItem.EntryID, Session.GetDefaultFolder(olFolderInbox).StoreID, rtf)
+ rtf = Trim(rtf)
+
+ Debug.Print "RTF READ:" & ret & vbCrLf & rtf
+End Sub
+
+Public Sub TestColors()
+ Dim mi As MailItem
+ 'Set mi = Session.GetDefaultFolder(olFolderInbox).Items(99)
+ Set mi = GetCurrentItem()
+ 'mi.Display
+
+ Dim answer As MailItem
+ Set answer = mi.reply
+ Set mi = Nothing
+
+ answer.BodyFormat = olFormatRichText
+
+ Dim mid As String
+ 'mid = QuoteColorizerMacro.ColorizeMailItem(answer)
+ answer.Display
+ Set answer = Nothing 'answer bodyformat changes here to 1 for some stupid reason...
+
+ 'Call Tools.DisplayMailItemByID(mid)
+End Sub
+
+
+Public Sub FranksMacro(CurrentItem As MailItem)
+ 'put mails with me as the ONLY recipient into one folder, all others into another
+
+ 'declare mapifolders to move to here...
+
+
+ If (CurrentItem.Recipients.count > 1) Then
+ 'put into "uninteresting" folder...
+ 'CurrentItem.Move(...)
+ Else
+ 'put into "interesting" folder
+ 'CurrentItem.Move
+ End If
+
+End Sub
+
+
+Public Sub TestPar()
+ Dim s As String
+ Dim ret As String
+ Dim cmd As String
+
+ Dim shell As Object
+ Dim pipe As Object
+ Set shell = CreateObject("WScript.Shell")
+
+ s = "test daniel 23e " & vbCrLf & _
+ "> asd asd sad " & vbCrLf & _
+ "> sad asdad as " & vbCrLf & _
+ ">> sa asddsa asd aas kj kj kj k jlkjhlkjhsda asdf asdf adsf as df asdf ads fa dsfa dsf " & vbCrLf & _
+ ">> aasd asdaasdf asd fasdf asd f asd fa sdf adsf asdf saas " & vbCrLf & _
+ "> sasad asda sasd asd asd asd asd aasdf asdf as df asdf a sd f asd f as df asd fasdf a sdf asdf sdasdasd "
+
+ cmd = "C:\Programme\cygwin\bin\bash.exe --login -c 'export PARINIT=""rTbgqR B=.,?_A_a Q=_s>|"" ; par 60q'"
+
+ Debug.Print cmd
+ Set pipe = shell.Exec(cmd)
+ Debug.Print "END PAR"
+
+ pipe.StdIn.Write (s)
+ pipe.StdIn.Close
+
+
+ Debug.Print "READING..."
+ 'While (pipe.StdOut.AtEndOfStream = False)
+ ' ret = ret + pipe.StdOut.ReadLine() + vbCrLf
+ 'Wend
+ ret = pipe.StdOut.ReadAll()
+ Debug.Print ret
+
+ Set pipe = Nothing
+ Set shell = Nothing
+End Sub
+
Property changes on: testing/Tools.bas
___________________________________________________________________
Added: svn:keywords
+ 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 13:35:32
|
Revision: 63
http://macros4outlook.svn.sourceforge.net/macros4outlook/?rev=63&view=rev
Author: olly98
Date: 2011-04-22 13:35:26 +0000 (Fri, 22 Apr 2011)
Log Message:
-----------
Added header information
Modified Paths:
--------------
addcontactmacro/trunk/AddContactMacro.bas
Property Changed:
----------------
addcontactmacro/trunk/AddContactMacro.bas
Modified: addcontactmacro/trunk/AddContactMacro.bas
===================================================================
--- addcontactmacro/trunk/AddContactMacro.bas 2011-04-22 12:42:01 UTC (rev 62)
+++ addcontactmacro/trunk/AddContactMacro.bas 2011-04-22 13:35:26 UTC (rev 63)
@@ -1,4 +1,27 @@
Attribute VB_Name = "AddContactMacro"
+'$Id$
+'
+'Add Contact Macro TRUNK
+'
+'Add Contact Macro is part of the macros4outlook project
+'see https://sourceforge.net/apps/mediawiki/macros4outlook/index.php?title=Add_Contact_Macro or
+' http://sourceforge.net/projects/macros4outlook/ for more information
+'
+'For more information on Outlook see http://www.microsoft.com/outlook
+'Outlook is (C) by Microsoft
+
+'****************************************************************************
+'License:
+'
+' sample Outlook 2003 VBA application by Sue Mosher
+' send questions/comments to web...@ou...
+' modified by dan...@us...
+'****************************************************************************
+
+'Changelog
+'
+'$Revision$ - not released
+
Option Explicit
@@ -6,9 +29,6 @@
-' sample Outlook 2003 VBA application by Sue Mosher
-' send questions/comments to web...@ou...
-' modified by dan...@us...
Public Sub AddRecipToContacts(ByVal MailItem As Object)
Dim strFind As String
@@ -32,7 +52,7 @@
Set objNS = Application.GetNamespace("MAPI")
Set objContactFolder = objNS.GetDefaultFolder(olFolderContacts)
- On Error Resume Next 'to skip error if folder isnt in .Folders(...)!
+ On Error Resume Next 'to skip error if folder isn't in .Folders(...)!
'see if autocontactfolder already exists
Set objNewContactFolder = objContactFolder.Folders(AUTO_CONTACT_FOLDER_NAME)
If (objNewContactFolder Is Nothing) Then 'error occured!
@@ -59,7 +79,7 @@
If objContact Is Nothing Then
Set objContact = Application.CreateItem(olContactItem)
With objContact
- .FullName = Replace(objRecip.name, "'", "")
+ .FullName = Replace(objRecip.Name, "'", "")
.Email1Address = objRecip.Address
.Save
.Move objNewContactFolder
@@ -79,5 +99,3 @@
Private Function AddQuote(MyText As String) As String
AddQuote = Chr(34) & MyText & Chr(34)
End Function
-
-
Property changes on: addcontactmacro/trunk/AddContactMacro.bas
___________________________________________________________________
Added: svn:keywords
+ Id Revision
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|