I process dozens of email messages every day with a similar format. The
email subjects are duplicative, non-descriptive and not unique - useless to
use as descriptive filenames when I save these emails as text files. I am
trying to write a macro to search each of these emails for the string "ITEM:"
then to save the email message as a text file using the characters after
"ITEM:" as a unique descriptive filename. I also anticipate having to
convert frequently occuring "/" to "_" out of that string to facilitate use
as a filename.

Sample email body is below:
----------------------------------------------------------

The projected date for the release of the project listed below is now past
due. Please contact the coordinator if this date needs to be changed.

FORECASTED DATE FOR PROJECT NOW PAST DUE:




ITEM: WIDGET/WW1
PROJECT DEVELOPER: MN WIDGET
CONTROL ID: WIDG1


GAINING ORGANIZATION: CMD

More information on this release can be viewed at:

https://widgetmanagers

Please do not reply to this email as it was automatically generated.

Regards,

All the functions below should help you validate Subject lines for valid file
name strings and format them accordingly:

Function IsValidFileName(FileName) As Boolean
On Error Resume Next

If InStr(FileName, "\") 0 Then Exit Function
If InStr(FileName, "/") 0 Then Exit Function
If InStr(FileName, ":") 0 Then Exit Function
If InStr(FileName, "*") 0 Then Exit Function
If InStr(FileName, "?") 0 Then Exit Function
If InStr(FileName, Chr(34)) 0 Then Exit Function
If InStr(FileName, "") 0 Then Exit Function
If InStr(FileName, "") 0 Then Exit Function
If InStr(FileName, "|") 0 Then Exit Function
IsValidFileName = True
End Function

'************************************************* *****************************
'Custom procedu CleanFileName
'Purpose: Remove illegal characters from filename
'Argument: strSubject
'Usage:
'Returns: String representing file name
'************************************************* *****************************
Public Function CleanFileName(strFileName As String) As String
On Error Resume Next

Dim intX As Integer

If InStr(strFileName, ":") Then
strFileName = CleanString(strFileName, ":")
End If
If InStr(strFileName, "/") Then
strFileName = CleanString(strFileName, "/")
End If
If InStr(strFileName, "\") Then
strFileName = CleanString(strFileName, "\")
End If
If InStr(strFileName, "") Then
strFileName = CleanString(strFileName, "")
End If
If InStr(strFileName, "") Then
strFileName = CleanString(strFileName, "")
End If
If InStr(strFileName, "|") Then
strFileName = CleanString(strFileName, "|")
End If
If InStr(strFileName, "*") Then
strFileName = CleanString(strFileName, "*")
End If
If InStr(strFileName, "?") Then
strFileName = CleanString(strFileName, "?")
End If

CleanFileName = Trim(strFileName)
End Function

'************************************************* *****************************
'Custom procedu CleanString
'************************************************* *****************************
Function CleanString(strSource As String, strRemove As String) As String
On Error Resume Next


CleanString = Replace(strSource, strRemove, "", , , vbTextCompare)
End Function

--
Eric Legault (Outlook MVP, MCDBA, MCTS: Messaging & Collaboration)
Try Picture Attachments Wizard for Outlook:
http://www.collaborativeinnovations.ca
Blog: http://blogs.officezealot.com/legault/


"bsteiner" wrote:

I process dozens of email messages every day with a similar format. The
email subjects are duplicative, non-descriptive and not unique - useless to
use as descriptive filenames when I save these emails as text files. I am
trying to write a macro to search each of these emails for the string "ITEM:"
then to save the email message as a text file using the characters after
"ITEM:" as a unique descriptive filename. I also anticipate having to
convert frequently occuring "/" to "_" out of that string to facilitate use
as a filename.

Sample email body is below:
----------------------------------------------------------

The projected date for the release of the project listed below is now past
due. Please contact the coordinator if this date needs to be changed.

FORECASTED DATE FOR PROJECT NOW PAST DUE:




ITEM: WIDGET/WW1
PROJECT DEVELOPER: MN WIDGET
CONTROL ID: WIDG1


GAINING ORGANIZATION: CMD

More information on this release can be viewed at:

https://widgetmanagers

Please do not reply to this email as it was automatically generated.

Regards,

Eric - great info.

The code for my macro is below. I'm close, but I am failing miserably in
the simple task of converting the copied text I have cleaned (brute force
method), selected and copied into a new filename! The offending line, of
course, is:

sNewFileName = Selection.Paste

and I can't fix it...

Pete

Sub test()
'
' test Macro
' Macro recorded 6/1/2006 by US Army
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "item"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdWord, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.MoveRight Unit:=wdCharacter, Count:=25, Extend:=wdExtend
Selection.Copy
Selection.MoveDown Unit:=wdScreen, Count:=1
Selection.Paste
Selection.TypeParagraph
ActiveDocument.SaveAs FileName:="Matrix System plus spares.doc", _
FileFormat:=wdFormatDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="",
ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData _
:=False, SaveAsAOCELetter:=False
End Sub
Sub MRSave()
'
' MRSave Macro
' Macro recorded 6/1/2006 by US Army
'
Dim sNewFileName As String
Dim sOldFileName As String

Selection.MoveUp Unit:=wdScreen, Count:=3
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "/"
.Replacement.Text = "_"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = ":"
.Replacement.Text = "_"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "\"
.Replacement.Text = "_"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
With Selection.Find
.Text = "item"
.Replacement.Text = "_"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdWord, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=30, Extend:=wdExtend
Selection.Copy
sNewFileName = Selection.Paste
ChangeFileOpenDirectory _
"S:\Updates\"
sOldFileName = ActiveDocument.FullName
ActiveDocument.SaveAs FileName:=sNewFileName, _
FileFormat:=wdFormatDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="",
ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData _
:=False, SaveAsAOCELetter:=False
ActiveDocument.Close
End Sub

"Eric Legault [MVP - Outlook]" wrote:

All the functions below should help you validate Subject lines for valid file
name strings and format them accordingly:

Function IsValidFileName(FileName) As Boolean
On Error Resume Next

If InStr(FileName, "\") 0 Then Exit Function
If InStr(FileName, "/") 0 Then Exit Function
If InStr(FileName, ":") 0 Then Exit Function
If InStr(FileName, "*") 0 Then Exit Function
If InStr(FileName, "?") 0 Then Exit Function
If InStr(FileName, Chr(34)) 0 Then Exit Function
If InStr(FileName, "") 0 Then Exit Function
If InStr(FileName, "") 0 Then Exit Function
If InStr(FileName, "|") 0 Then Exit Function
IsValidFileName = True
End Function

'************************************************* *****************************
'Custom procedu CleanFileName
'Purpose: Remove illegal characters from filename
'Argument: strSubject
'Usage:
'Returns: String representing file name
'************************************************* *****************************
Public Function CleanFileName(strFileName As String) As String
On Error Resume Next

Dim intX As Integer

If InStr(strFileName, ":") Then
strFileName = CleanString(strFileName, ":")
End If
If InStr(strFileName, "/") Then
strFileName = CleanString(strFileName, "/")
End If
If InStr(strFileName, "\") Then
strFileName = CleanString(strFileName, "\")
End If
If InStr(strFileName, "") Then
strFileName = CleanString(strFileName, "")
End If
If InStr(strFileName, "") Then
strFileName = CleanString(strFileName, "")
End If
If InStr(strFileName, "|") Then
strFileName = CleanString(strFileName, "|")
End If
If InStr(strFileName, "*") Then
strFileName = CleanString(strFileName, "*")
End If
If InStr(strFileName, "?") Then
strFileName = CleanString(strFileName, "?")
End If

CleanFileName = Trim(strFileName)
End Function

'************************************************* *****************************
'Custom procedu CleanString
'************************************************* *****************************
Function CleanString(strSource As String, strRemove As String) As String
On Error Resume Next


CleanString = Replace(strSource, strRemove, "", , , vbTextCompare)
End Function

--
Eric Legault (Outlook MVP, MCDBA, MCTS: Messaging & Collaboration)
Try Picture Attachments Wizard for Outlook:
http://www.collaborativeinnovations.ca
Blog: http://blogs.officezealot.com/legault/


"bsteiner" wrote:

I process dozens of email messages every day with a similar format. The
email subjects are duplicative, non-descriptive and not unique - useless to
use as descriptive filenames when I save these emails as text files. I am
trying to write a macro to search each of these emails for the string "ITEM:"
then to save the email message as a text file using the characters after
"ITEM:" as a unique descriptive filename. I also anticipate having to
convert frequently occuring "/" to "_" out of that string to facilitate use
as a filename.

Sample email body is below:
----------------------------------------------------------

The projected date for the release of the project listed below is now past
due. Please contact the coordinator if this date needs to be changed.

FORECASTED DATE FOR PROJECT NOW PAST DUE:




ITEM: WIDGET/WW1
PROJECT DEVELOPER: MN WIDGET
CONTROL ID: WIDG1


GAINING ORGANIZATION: CMD

More information on this release can be viewed at:

https://widgetmanagers

Please do not reply to this email as it was automatically generated.

Regards,

Now you're venturing into a topic that should be discussed in a word
programming newsgroup. I do know that the Paste method doesn't return
anything, so you can't assign it to a variable. I believe after you use the
Paste method you should be able to use Selection.Text to get what you just
pasted.

--
Eric Legault (Outlook MVP, MCDBA, MCTS: Messaging & Collaboration)
Try Picture Attachments Wizard for Outlook:
http://www.collaborativeinnovations.ca
Blog: http://blogs.officezealot.com/legault/


"bsteiner" wrote:

Eric - great info.

The code for my macro is below. I'm close, but I am failing miserably in
the simple task of converting the copied text I have cleaned (brute force
method), selected and copied into a new filename! The offending line, of
course, is:

sNewFileName = Selection.Paste

and I can't fix it...

Pete

Sub test()
'
' test Macro
' Macro recorded 6/1/2006 by US Army
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "item"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdWord, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.MoveRight Unit:=wdCharacter, Count:=25, Extend:=wdExtend
Selection.Copy
Selection.MoveDown Unit:=wdScreen, Count:=1
Selection.Paste
Selection.TypeParagraph
ActiveDocument.SaveAs FileName:="Matrix System plus spares.doc", _
FileFormat:=wdFormatDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="",
ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData _
:=False, SaveAsAOCELetter:=False
End Sub
Sub MRSave()
'
' MRSave Macro
' Macro recorded 6/1/2006 by US Army
'
Dim sNewFileName As String
Dim sOldFileName As String

Selection.MoveUp Unit:=wdScreen, Count:=3
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "/"
.Replacement.Text = "_"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = ":"
.Replacement.Text = "_"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "\"
.Replacement.Text = "_"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
With Selection.Find
.Text = "item"
.Replacement.Text = "_"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdWord, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=30, Extend:=wdExtend
Selection.Copy
sNewFileName = Selection.Paste
ChangeFileOpenDirectory _
"S:\Updates\"
sOldFileName = ActiveDocument.FullName
ActiveDocument.SaveAs FileName:=sNewFileName, _
FileFormat:=wdFormatDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="",
ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData _
:=False, SaveAsAOCELetter:=False
ActiveDocument.Close
End Sub

"Eric Legault [MVP - Outlook]" wrote:

All the functions below should help you validate Subject lines for valid file
name strings and format them accordingly:

Function IsValidFileName(FileName) As Boolean
On Error Resume Next

If InStr(FileName, "\") 0 Then Exit Function
If InStr(FileName, "/") 0 Then Exit Function
If InStr(FileName, ":") 0 Then Exit Function
If InStr(FileName, "*") 0 Then Exit Function
If InStr(FileName, "?") 0 Then Exit Function
If InStr(FileName, Chr(34)) 0 Then Exit Function
If InStr(FileName, "") 0 Then Exit Function
If InStr(FileName, "") 0 Then Exit Function
If InStr(FileName, "|") 0 Then Exit Function
IsValidFileName = True
End Function

'************************************************* *****************************
'Custom procedu CleanFileName
'Purpose: Remove illegal characters from filename
'Argument: strSubject
'Usage:
'Returns: String representing file name
'************************************************* *****************************
Public Function CleanFileName(strFileName As String) As String
On Error Resume Next

Dim intX As Integer

If InStr(strFileName, ":") Then
strFileName = CleanString(strFileName, ":")
End If
If InStr(strFileName, "/") Then
strFileName = CleanString(strFileName, "/")
End If
If InStr(strFileName, "\") Then
strFileName = CleanString(strFileName, "\")
End If
If InStr(strFileName, "") Then
strFileName = CleanString(strFileName, "")
End If
If InStr(strFileName, "") Then
strFileName = CleanString(strFileName, "")
End If
If InStr(strFileName, "|") Then
strFileName = CleanString(strFileName, "|")
End If
If InStr(strFileName, "*") Then
strFileName = CleanString(strFileName, "*")
End If
If InStr(strFileName, "?") Then
strFileName = CleanString(strFileName, "?")
End If

CleanFileName = Trim(strFileName)
End Function

'************************************************* *****************************
'Custom procedu CleanString
'************************************************* *****************************
Function CleanString(strSource As String, strRemove As String) As String
On Error Resume Next


CleanString = Replace(strSource, strRemove, "", , , vbTextCompare)
End Function

--
Eric Legault (Outlook MVP, MCDBA, MCTS: Messaging & Collaboration)
Try Picture Attachments Wizard for Outlook:
http://www.collaborativeinnovations.ca
Blog: http://blogs.officezealot.com/legault/


"bsteiner" wrote:

I process dozens of email messages every day with a similar format. The
email subjects are duplicative, non-descriptive and not unique - useless to
use as descriptive filenames when I save these emails as text files. I am
trying to write a macro to search each of these emails for the string "ITEM:"
then to save the email message as a text file using the characters after
"ITEM:" as a unique descriptive filename. I also anticipate having to
convert frequently occuring "/" to "_" out of that string to facilitate use
as a filename.

Sample email body is below:
----------------------------------------------------------

The projected date for the release of the project listed below is now past
due. Please contact the coordinator if this date needs to be changed.

FORECASTED DATE FOR PROJECT NOW PAST DUE:




ITEM: WIDGET/WW1
PROJECT DEVELOPER: MN WIDGET
CONTROL ID: WIDG1


GAINING ORGANIZATION: CMD

More information on this release can be viewed at:

https://widgetmanagers

Please do not reply to this email as it was automatically generated.

Regards,