VBA to save open word file with name created from words in file

Lord Jim · #1 08-30-2021, 04:09 PM

I try to write a simple macro to save open file with name created from certain words in a document, namely dates (from - to) in document entered as strings.

AS you guessed correctly, my knowledge of VBA is limited to modifying recorded macros
hope to get some help
thank you in advance

gmayor · #2 08-30-2021, 08:24 PM

While this is theoretically possible,it would not be possible without access to a sample document to establish where the date strings are located. Can you post a document or a link to such a document? Bear in mind also that some date formats contain characters that cannot be used in a filename, so how is the name to be formatted?

Lord Jim · #3 09-01-2021, 03:01 PM

Thanks Graham: I somehow managed to created a macro (maybe I'm not as dummy as I though)
Dim wbname As String
Dim pathONLY, filePATH, fileONLY As String
Dim datefrom As String
Dim dateto As String

' Selection.Find.ClearFormatting
With Selection.Find
.Text = "????.??.??"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.Copy
datefrom = Selection.Text
datefrom = Right(datefrom, 8)
Selection.Find.Execute
Selection.Copy
dateto = Selection.Text
dateto = Right(dateto, 8)
wbname = datefrom & "-" & dateto
filePATH = ActiveDocument.FullName
fileONLY = ActiveDocument.Name
pathONLY = Left(filePATH, Len(filePATH) - Len(fileONLY))

ChangeFileOpenDirectory pathONLY
ActiveDocument.SaveAs FileName:=pathONLY & wbname & ".doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False

thanks again for quick answear

gmayor · #4 09-02-2021, 01:03 AM

That macro would work if the document has previously been saved, otherwise there is no path associated with the document. I would suggest, based on your code which I assume works in your document:

Code:

Dim wbname As String
Dim filePATH As String
Dim datefrom As String
Dim dateto As String
Dim fDialog As FileDialog

    If ActiveDocument.path = "" Then
        Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
        With fDialog
            .Title = "Select folder to save the document"
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewList
            If .Show <> -1 Then
                filePATH = ""
            Else
                filePATH = fDialog.SelectedItems.Item(1) & Chr(92)
            End If
        End With
    Else
        filePATH = ActiveDocument.path
    End If
    If filePATH = "" Then
        MsgBox "No folder selected", vbCritical
        Exit Sub
    End If

    ' Selection.Find.ClearFormatting
    Selection.HomeKey wdStory
    With Selection.Find
        .Text = "????.??.??"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    datefrom = Selection.Text
    If Len(datefrom) < 8 Then
        MsgBox "Date From - not found", vbCritical
        Exit Sub
    End If
    datefrom = Right(datefrom, 8)
    Selection.Collapse 0
    Selection.Find.Execute
    dateto = Selection.Text
    If Len(dateto) < 8 Then
        MsgBox "Date To - not found", vbCritical
        Exit Sub
    End If
    dateto = Right(dateto, 8)
    wbname = datefrom & "-" & dateto

    ActiveDocument.SaveAs FileName:=filePATH & wbname & ".doc", FileFormat:= _
                          wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
                          True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
                          False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
                          SaveAsAOCELetter:=False

Lord Jim · #5 09-02-2021, 02:33 PM

Of course you right, Your code is better for sure, thanks - I basically was implementing macro to change file name produced by dBASEIV in format 8.3 to name more meaningful, that why my code was working
thank again

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Open file which contains specific words in title	Nick70	PowerPoint	2	06-08-2016 06:55 AM
Macro to highlight repeated words in word file and extract into excel file	aabri	Word VBA	1	06-14-2015 07:20 AM
Word for Mac 2011: Change default open/save file locations?	cglenn	Word	0	06-01-2015 10:34 AM
Unable to open PST file, asking for Password, never created one!?!?	Stompandgo	Outlook	1	04-21-2015 12:07 PM
Unable to File>Save As.. or Open in Word 2010, please help	BrokenComputer	Word	0	03-07-2012 10:20 PM