分隔符上的 word 宏拆分文件答案

【问题标题】：word macro split file on delimeter分隔符上的 word 宏拆分文件
【发布时间】：2015-03-30 03:09:21
【问题描述】：

我有多个大型 docx 文件（word 2010），需要根据分隔符（“///”）进行拆分。我尝试使用给定的宏http://www.vbaexpress.com/forum/showthread.php?39733-Word-File-splitting-Macro-question

但是它在 colNotes(i).Copy (Sub SplitNotes(...)) 行上给出错误“此方法或属性不可用，因为没有选择文本”。

宏复制如下：

Sub testFileSplit()
    Call SplitNotes("///", "C:\Users\myPath\temp_DEL_008_000.docx")
End Sub
Sub SplitNotes(strDelim As String, strFilename As String)
    Dim docNew As Document
    Dim i As Long
    Dim colNotes As Collection
    Dim temp As Range

    'get the collection of ranges
    Set colNotes = fGetCollectionOfRanges(ActiveDocument, strDelim)

    'see if the user wants to proceed
    If MsgBox("This will split the document into " & _
    colNotes.Count & _
    " sections. Do you wish to proceed?", vbYesNo) = vbNo Then
        Exit Sub
    End If

     'go through the collection of ranges
    For i = 1 To colNotes.Count
         'create a new document
        Set docNew = Documents.Add

        'copy our range
        colNotes(i).Copy
         'paste it in
        docNew.Content.Paste
         'save it
        docNew.SaveAs fileName:=ThisDocument.path & "\" & strFilename & Format(i, "000"), FileFormat:=wdFormatDocument

        docNew.Close
    Next
End Sub
Function fGetCollectionOfRanges(oDoc As Document, strDelim As String) As Collection
    Dim colReturn As Collection
    Dim rngSearch As Range
    Dim rngFound As Range

     'initialize a new collection
    Set colReturn = New Collection
     'initialize our starting ranges
    Set rngSearch = oDoc.Content
    Set rngFound = rngSearch.Duplicate

     'start our loop
    Do
         'search through
        With rngSearch.Find
            .Text = strDelim
            .Execute
             'if we found it... prepare to add to our collection
            If .Found Then
                 'redefine our rngfound
                rngFound.End = rngSearch.Start
                 'add it to our collection
                colReturn.Add rngFound.Duplicate
                 'reset our search and found for the next
                rngSearch.Collapse wdCollapseEnd
                rngFound.Start = rngSearch.Start
                rngSearch.End = oDoc.Content.End
            Else
                 'if we didn't find, exit our loop
                Exit Do
            End If
        End With
         'shouldn't ever hit this... unless the delimter passed in is a VBCR
    Loop Until rngSearch.Start >= ActiveDocument.Content.End

     'and return our collection
    Set fGetCollectionOfRanges = colReturn
End Function

【问题讨论】：

我认为错误消息仍然是问题所在。尝试在引发错误的行之前添加colNotes(i).Range.Select。

标签： vba ms-office ms-word

【解决方案1】：

对于那些可能感兴趣的人：该代码在 2010 年确实有效。问题是分隔符，这是文件中的第一件事...... 删除它并且它工作......

【讨论】：