Hi Greg,
it seems to work great until the save line, get this error:
Run-time error '5487'
Word cannot complete the save due to file permissionerror
any ideas?
"Greg Maxey" wrote:
> Maybe something like this:
> Sub ScratchMacro()
> Dim oRng As Range
> Dim pStr As String
> Dim oDoc As Document
> Set oRng = Selection.Range
> oRng.Start = Selection.Range.Start
> If Selection.Words.Count > 5 Then
> oRng.End = Selection.Words(5).End
> Else
> MsgBox "Please select the range of text to save as new document."
> Exit Sub
> End If
> If Not oRng.Characters.Last Like "[A-Za-z]" Then
> oRng.MoveEnd wdCharacter, -1
> End If
> pStr = "D:\My websites\" & oRng.Text & ".docx"
> Selection.Copy
> Set oDoc = Documents.Add
> Selection.PasteAndFormat (wdPasteDefault)
> oDoc.SaveAs (pStr)
> oDoc.Close
> End Sub
>
>
> --
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~
> Greg Maxey - Word MVP
>
> My web site http://gregmaxey.mvps.org
> Word MVP web site http://word.mvps.org
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
>
>
>
> Jim wrote:
> > I have the following simple macro to take a selection from a long
> > document and create a new document from it, the problem is that
> > every time I use it, the new file is saved to the same file name and
> > over writes the old one. What I would like is to have the file saved
> > to the default suggested file name that word would normally generate
> > from the first line of the selection. Anyone know what the variable
> > for FileName should be to make this so?
> >
> > Thanks Jim
> >
> > Sub NewDocFromSelection()
> > '
> > ' NewDocFromSelection Macro
> > ' Create new document from selection
> > '
> > Selection.Copy
> > Documents.Add DocumentType:=wdNewBlankDocument
> > Selection.PasteAndFormat (wdPasteDefault)
> > ChangeFileOpenDirectory "D:\My websites\"
> > ActiveDocument.SaveAs FileName:="What causes this Syndrome.docx", _
> > FileFormat:=wdFormatXMLDocument, LockComments:=False,
> > Password:="", _ AddToRecentFiles:=True, WritePassword:="",
> > ReadOnlyRecommended:=False, _
> > EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
> > SaveFormsData _
> > :=False, SaveAsAOCELetter:=False
> > ActiveWindow.Close
> > End Sub
>
>
>