分隔符上的字宏分割文件

时间:2014-04-28 07:48:26

标签: vba ms-word ms-office word-vba

我有多个大型docx文件(单词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

1 个答案:

答案 0 :(得分:0)

对于那些可能感兴趣的人: 该代码在2010年工作。问题是分隔符,这是文件中的第一件事...... 删除它,它工作...