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

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/15936482/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 20:32:51  来源:igfitidea点击:

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

vbams-wordword-vba

提问by user2259920

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.

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

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

采纳答案by Dick Kusleika

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.

这里有两个函数可以为您构建文件名。您为表提供数据,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

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