2014-04-28 35 views
0

我有多個需要根據分隔符(「///」)分割的大型docx文件(單詞2010)。我嘗試使用給定的宏http://www.vbaexpress.com/forum/showthread.php?39733-Word-File-splitting-Macro-questiondelimeter上的單詞宏分割文件

但是,它在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 
+0

我認爲錯誤消息保持完全是問題所在。嘗試在引發錯誤的行之前添加'colNotes(i).Range.Select'。 –

回答

0

對於那些誰可能會感興趣: 的代碼確實在2010年工作中的問題是,這是該文件的第一件事分隔符... 刪除它和它的工作...