RE: Search email for text string to use in filename - save email t

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 procedure: 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 procedure: 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,



.

Relevant Pages

  • RE: Search email for text string to use in filename - save email t
    ... .Format = False ... .MatchWholeWord = False ... Dim sNewFileName As String ... > 0 Then Exit Function ...
    (microsoft.public.outlook.program_vba)
  • Re: Word 2003 search macro
    ... string, positions the cursor at the string found, deletes the string, ... leaving the cursor where the string had been located. ... .MatchWholeWord = False ... However, if the string is not found, the macro deletes the character the ...
    (microsoft.public.word.vba.general)
  • macro that strips data from string
    ... further in the string. ... What I need is to strip from the second - to the ( ... macro was in a word doc, will it work in excel also? ... .MatchWholeWord = False ...
    (microsoft.public.excel)
  • Compile-time text/string manipulation
    ... A "compile-time language" is one that processes ... Compile time languages for assemblers ... This group includes macro ... requires access to various string and text manipulation ...
    (alt.lang.asm)
  • Re: Document Property to display more than 1 line
    ... then use the following macro to identify the character ... Dim strNums As String ...
    (microsoft.public.word.newusers)