The code for a simple word macro (built using macro recorder) is below. I use
it inside of Outlook to save messages with a filename that is extracted from
a specific line of expected text. 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!!...
bsteiner
Sub test()
'
' test Macro
' Macro recorded 6/1/2006
'
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