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

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

1 个答案: