1

我有一个包含多人及其详细信息的 Word 文件。

我需要将此文件拆分为每个人的单个文件。

这是代码，大部分来自我找到的示例。

我需要按分隔符（个人）拆分文件。
每个文件都需要通过位于分隔符下方的 ID 号来命名。

Sub SplitNotes (delim As String)

    Dim sText As String
    Dim sValues(10) As String
    Dim doc As Document
    Dim arrNotes
    Dim strFilename As String
    Dim Test As String
    Dim I As Long
    Dim X As Long
    Dim Response As Integer

    arrNotes = Split(ActiveDocument.Range, delim)
    Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections.Do you wish to proceed?", 4)
    If Response = 7 Then Exit Sub
    For I = LBound(arrNotes) To UBound(arrNotes)
        If Trim(arrNotes(I)) <> "" Then
            X = X + 1
            Set doc = Documents.Add
            doc.Range = arrNotes(I)
             'Find "EID: "
             doc.Range.Find.Text = "EID: "
             'Select whole line
             Selection.Expand wdLine
             'Assign text to variable
             sText = Selection.Text
             'Remove spaces
             sText = Replace(sText, " ", "")
             'Split string into values
             sValues = Split(sText, ":")

            strFilename = "Testing"
            doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "Agent")
            doc.Close True
        End If
    Next I
End Sub

Sub Test()
    'delimiter
    SplitNotes "Name:"
End Sub

Word文档设置如下：

    个人的
    姓名：约翰·史密斯
    EID：Alph4num3r1c（不是我所知道的设定长度）
    详细信息从这里开始

我的问题是获取 ID 号并在另存为功能中使用它。
我对拆分功能的工作原理没有完全了解。

4

2 回答 2

0

拆分函数根据分隔符将字符串拆分为字符串数组。例如：

Dim csvNames, arrNames
csvNames = "Tom,Dick,Harry"
arrNames = split(csvNames,",")

现在 arrNames 是一个包含 3 个元素的数组。您可以像这样遍历元素：

Dim i
For i = 0 to UBound(arrNames)
    response.write arrNames(i) & "<br />"
Next

现在应用拆分功能来解决您的问题。将您感兴趣的行读入变量中。可以说我们有，

Dim lineWithID, arrKeyValuePair
lineWithID = "EID: Alph4num3r1c"

使用冒号将其拆分为数组

arrKeyValuePair = Split(lineWithID,":")

现在， arrKeyValuePair(1) 将包含您的 EID

于 2013-05-30T05:17:03.563 回答
0

如果您的问题仍然有效，我对您搜索的文件名有一些解决方案。我没有检查您的代码的所有部分（所以我做了，但我没有您的原始文档来进行全面分析）。返回文件名 - 您可以使用以下简单逻辑从新创建的文档中提取名称：

'...beginning of your code here
'next part unchanged >>
For I = LBound(arrNotes) To UBound(arrNotes)
        If Trim(arrNotes(I)) <> "" Then
            X = X + 1
            Set doc = Documents.Add
            doc.Range = arrNotes(I)
'<<until this moment

'remove or comment your code here!!

'and add new part of the code to search for the name
    Selection.Find.Execute "EID:"
    Selection.MoveRight wdWord, 1
    Selection.Expand wdWord
    strFilename = Trim(Selection.Text)

'and back to your code- unchanged
            doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "Agent")
            doc.Close True
        End If
Next I
'...end of sub and other ending stuff

我检查了一下，对我来说工作得很好。

于 2013-05-30T13:09:05.303 回答