VBA从文档中的数据创建另存为文件名

Question

我在 MSWord 中有一个包含名称、日期和非数字数据的表。我想编写一个宏来提取这些数据并使其成为当用户点击另存为时，建议的文件名以特定顺序排列数据，以句点分隔。

表格如下所示：

第一栏：

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

第二栏：

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

我需要文件名采用以下格式：

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

我的代码：

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

Answer 1

这里有两个函数将为您构建文件名。您向表格​​提供数据，GetFileName 返回您想要的字符串。

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

可能有更好的方法可以将文本从表格中删除，但这是我所拥有的。用你的桌子，你得到

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

我不确定您是如何知道要使用哪个表的，但我想您知道。您只需将结果存储在一个变量中，并在现在硬编码的任何地方使用该变量。

在代码中使用

将以上代码粘贴到标准模块中。我无法从您的问题中看出哪个表包含构建文件名所需的信息，因此我假设它是本示例文档中的第一个表。声明一个变量来保存文件名。

Dim sFileName As String

在您需要文件名之前，在代码中的某个位置生成文件名并将其存储在变量中。

sFileName = GetFileName(ActiveDocument.Tables(1))

然后，无论您有硬编码的名称，使用该变量。

With Dialogs(wdDialogFileSaveAs)
   .Name = sFileName