VBA to create save-as filename from data within the document

Question

I have a table in MSWord that contains names, a date, and non-numerical data. I'd like to write a macro that extracts this data and makes it so that when the user hits Save As, the suggested filename arranges the data in a particular order, separated by periods.

Here's what the table looks like:

First Column:

Date     04/10/13
Name 1   Arthur Z
Name 2   Bea Y
Title 1  Cars

Second Column:

Title 2  Boats
Company  Burger King
Color    Red
Name 3   Caroline X

I need the filename to be in the following format:

Burger King.Red.Y.Bea.04-10-13.Arthur Z.(extension)

The code I have:

Sub FileSaveAs()
   ActiveDocument.Fields.Update
   ActiveDocument.Fields.Update

   'Updated twice because some of the fields that need 
   'to be updated rely on fields below it and since it 
   'doesn't take too long I didn't bother figuring out 
   'how to make it update backwards--but if anyone knows 
   'how, please lmk
    Dim r As Range
    Set r = ActiveDocument.Range
    Dim fld As Field
    Dim iCnt As Integer
    For Each fld In ActiveDocument.Fields
        'All this field and highlight stuff is to edit the 
        'document down--I have all this done
        If fld.Type = wdFieldFormTextInput Then iCnt = iCnt + 1
        Next
        If iCnt >= 1 Then
        Dim Response As VbMsgBoxResult
            Response = MsgBox("Delete notes and shading?", vbYesNo + vbQuestion)
              If Response = vbYes Then
                    With r.Find
                    .Highlight = True
                    .Forward = True
                    While .Execute
                    r.Delete
                    Wend
                    End With
        For Each fld In ActiveDocument.Fields
        fld.Select
            If fld.Type = wdFieldFormTextInput Then
            fld.Unlink
            End If
            Next
            With Dialogs(wdDialogFileSaveAs)
            .Name = "Burger King.Red.Y.Bea.04-10-13.Arthur Z.docm"
            .Show
            End With
            EndUndoSaver
            Exit Sub
    ElseIf Response = vbNo Then
    With Dialogs(wdDialogFileSaveAs)
    .Name = "Burger King.Red.Y.Bea.04-10-13.Arthur Z.docm"
    .Show
    End With
    End If
    EndUndoSaver
    Exit Sub
ElseIf iCnt = 0 Then
With Dialogs(wdDialogFileSaveAs)
.Name = "Burger King.Red.Y.Bea.04-10-13.Arthur Z.docm"
.Show
End With
End If
Set fld = Nothing
End Sub

Exactly which part of this are you having a problem with? Do you know any VBA at all? If Yes, what have you tried so far? — Tim Williams
I do, but not enough to get the specific filename. So far, I have coded enough to get it to work such that when I click "Save As" I can make the suggested filename whatever text I want in the macro, like "CRAZY.doc". I'm trying to figure out how I can get the macro to customize the suggested filename using the table. — user2259920
To be honest it's relatively easy. Show the code you have which would be easier... — Kazimierz Jawor
Posting your existing code: questions without any code generally have a much lower chance of getting an answer here. — Tim Williams

Dick Kusleika Dick Kusleika · Accepted Answer · 2013-04-11T13:36:11

Here are two functions that will build the file name for you. You supply the table with the data and GetFileName returns the string you want.

Public Function GetFileName(tbl As Table)

    Dim aReturn(1 To 7) As String
    Dim vaName2 As Variant

    aReturn(1) = CleanString(tbl.Cell(2, 2).Range.Text)
    aReturn(2) = CleanString(tbl.Cell(3, 2).Range.Text)
    vaName2 = Split(tbl.Cell(3, 1).Range.Text, Space(1))
    On Error Resume Next
        aReturn(3) = CleanString(vaName2(1))
    On Error GoTo 0
    aReturn(4) = CleanString(vaName2(0))
    aReturn(5) = Format(CleanString(tbl.Cell(1, 1).Range.Text), "mm-dd-yy")
    aReturn(6) = CleanString(tbl.Cell(2, 1).Range.Text)
    aReturn(7) = "txt"

    GetFileName = Join(aReturn, ".")

End Function

Public Function CleanString(ByVal sText As String)

    CleanString = Replace(Replace(sText, Chr$(7), vbNullString), vbCr, vbNullString)

End Function

There may be a better way to get the text out of the table, but it's all I've got. With your table, you get

?getfilename(thisdocument.Tables(1))
Burger King.Red.Y.Bea.04-10-13.Arthur Z.txt

I'm not sure how you know which table to use, but I presume you do. You just need to store the result in a variable and use that variable wherever it's hardcoded now.

To use in code

Paste the above code into a standard module. I can't tell from your question which table contains the information needed to build the file name, so I will assume it's the first table in the document for this example. Declare a variable to hold the file name.

Dim sFileName As String

Somewhere in your code before you need the file name, generate the file name and store it in the variable.

sFileName = GetFileName(ActiveDocument.Tables(1))

Then, wherever you have the name hardcoded, use the variable.

With Dialogs(wdDialogFileSaveAs)
   .Name = sFileName

VBA to create save-as filename from data within the document

1 Answers