MS word save as question

[ADAMC]

Hi all

This is a long shot and i never use word and now i could do with a macro to come to my rescue

In excel i know its possible to save a workbook as a cell value, something like

Sub SaveAsA1()
    ThisFile = Range("A1").Value
    ActiveWorkbook.SaveAs Filename:=ThisFile
End Sub

Anyway due to a recent failed audit i now have to save all word docs in a set format: Like author published date review date.doc

Author/Published and review date are always in the same place on each doc, so my question is does anyone know if there is a macro which can save word docs based on content:

Thisworddoc.saveas filename: Page1 column one blah blah....?

Any help greatly apppreciated i have hundreds of docs to change file name. Any excel solutions perhaps also greatly welcome

Perhaps its not possible....?

Thanks for any input!!!!

 

[Marbles]

Assuming they will always be in the same place, the macro below is a way of doing it.

It creates 3 Bookmarks and then saves the document with the text of those Bookmarks joined together.

If you save the macro in "all active templates and documents", every time you open one of the files, you can run the macro.

My Line and Character counts are just examples.

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 25/10/2007 by Me
'
    Selection.HomeKey Unit:=wdStory
    Selection.MoveDown Unit:=wdLine, Count:=10
    Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="A"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    Selection.HomeKey Unit:=wdStory
    Selection.MoveDown Unit:=wdLine, Count:=6
    Selection.MoveRight Unit:=wdCharacter, Count:=6, Extend:=wdExtend
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="B"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    Selection.HomeKey Unit:=wdStory
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="C"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
   End With
    End With
    ActiveDocument.SaveAs FileName:=ActiveDocument.Bookmarks(1).Range & ActiveDocument.Bookmarks(2).Range & ActiveDocument.Bookmarks(3).Range, FileFormat:=wdFormatDocument, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False
End Sub

 

[Marbles]

Sorry, I forgot the amount of characters can change, but it might help anyway.

 

[ADAMC]

Marbles

Thanks that should be a great help to me. If it makes any difference the data to save format is always in the header and footer??

 

[ADAMC]

Hi Marbles,

Can you please also explain what this macro does..?

Cant seem to get it to save anything.....which line do i need to type on to test it...?

 

[Marbles]

If you copy the code, then go to Tools - Macro - Visual Basic Editor, then paste it there. Then if you run the macro, it will save the document with the combined texts at the end of the bookmarks. But like I said, I forgot the text would be different sizes. I'll see if you can save the file as a combination of field names, as I think that's what you have.

 

[Marbles]

This example makes 3 Bookmarks from 3 different lines in the Header, then saves them joined togher with commas in between.
The first line has Author Field, the second has Created Date Field, and the third has some text.

I don't know how your's are set up, but this example might help.
Also when saving Word won't let a / be used in the name.

Sub Try()
'
' Try Macro
' Macro recorded 27/10/2007 by Me
'
    Selection.HomeKey Unit:=wdStory
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="A"
        .DefaultSorting = wdSortByName
        .ShowHidden = True
    End With
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    
    Selection.HomeKey Unit:=wdStory
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="B"
        .DefaultSorting = wdSortByName
        .ShowHidden = True
    End With
    
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    Selection.HomeKey Unit:=wdStory
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="C"
        .DefaultSorting = wdSortByName
        .ShowHidden = True
    End With
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    
    ActiveDocument.SaveAs FileName:=ActiveDocument.Bookmarks(1).Range & "," & ActiveDocument.Bookmarks(2).Range & "," & ActiveDocument.Bookmarks(3).Range, FileFormat:=wdFormatDocument, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False
End Sub

Gives: Me,Sat Oct 2007,Tryout.doc

 

[ADAMC]

Hi marbles, thanks for this sorry i havent said thanks sooner, only just got round to looking at this now.

Thanks for the code should be a great help now i understand it

My only issue is with the text being hardcoded it wont always return the right result IE author wont always be 10 characters in length but i am sure there are easy ways round it, i might just make author name a persons initials unless i can find a way to dynamically save the author name as a field.

Thanks

 

[Marbles]

If the author, published date, review date are on separate lines, then the example I tried with ten characters took the word Tryout, with six letters, and cut the blanks when saving it. So you could set it to more characters and still catch the name.

 

[Macropod]

Hi Adam,

Word's Built-In Document Properties can be used to retrieve the authors' names, and the file's creation date. Assuming your system is set up with the User names (see Tools|Options|User Information), then something along the following lines should work:

Sub SaveDoc()
Dim StrNm As String
With ActiveDocument
    If .BuiltInDocumentProperties(wdPropertyAuthor) <> "" Then
        StrNm = .BuiltInDocumentProperties(wdPropertyAuthor)
    Else
        StrNm = "Created by Anon."
    End If
    StrNm = StrNm & "_" & Format(.BuiltInDocumentProperties(wdPropertyTimeCreated), "dd-MM-yyyy")
    If .BuiltInDocumentProperties(wdPropertyLastAuthor) <> "" Then
        StrNm = StrNm & "_" & .BuiltInDocumentProperties(wdPropertyLastAuthor)
    Else
        StrNm = StrNm & "_" & "Revised by Anon."
    End If
    StrNm = StrNm & "_" & Format(Now, "dd-MM-yyyy")
End With
.SaveAs FileName:=StrNm
End Sub

If you want to intercept the standard save dialogue box, see: http://word.mvps.org/FAQs/MacrosVBA/InterceptSavePrint.htm

Cheers