为什么循环在 Visual Basic 代码中不停止

Question

我有一个 Visual Basic 代码，可以将 Word 文档转换为 Excel，但循环没有停止并继续将数据写入 Excel。我是一名 ETL 顾问，不熟悉 VB 代码。请帮我看看这段代码有什么问题。

Sub Macro1()
      Dim oTbl As Table
      Dim oRow As Row
      Dim i As Long
      Dim j As Long
      Dim xl As Object
      Set xl = CreateObject("excel.application")

      xl.workbooks.Add
      xl.Visible = True

      'Here put your path where you have your documents to read:
      myPath = "C:\Users\mukhan\"  'End with '\'
      myFile = Dir(myPath & "*.docx")

       xlRow = 1
       Do While myFile <> ""
         Documents.Open FileName:=myPath & myFile, ConfirmConversions:=False, _
           ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
           PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
           WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""

        xlCol = 0
        For Each oTbl In ActiveDocument.Tables
         
         
         
         For i = 1 To oTbl.Rows.Count
            On Error Resume Next
            i = oTbl.Rows(i).Index
            If Err.Number <> 5991 Then
                With oTbl.Rows(i)
                    For j = 1 To .Cells.Count
                        With .Cells(j)
                           'do stuff
                           
                           
                                For Each r In oTbl.Rows
                                     For Each c In r.Range.Cells
                                        myText = c
                                        myText = Replace(myText, Chr(13), "")
                                        myText = Replace(myText, Chr(7), "")
                                        xlCol = xlCol + 1
                                        xl.activeworkbook.activesheet.Cells(xlRow, xlCol) = myText

                                     Next c
                                  xlRow = xlRow + 1
                                  xlCol = 0
                               Next r
                               
                        End With
                    Next j
                End With
            End If
        Next i
                               
      
         Next oTbl
                               ActiveWindow.Close False

                               myFile = Dir
      Loop

      xl.Visible = True
End Sub

Answer 1

试试这个代码：

Sub Test()

    Dim xl As Object
    Set xl = CreateObject("excel.application")
    xl.Visible = True
    
    Dim wrkBk As Object
    Set wrkBk = xl.WorkBooks.Add
    
    Dim myPath As String
    myPath = "C:\Users\mukhan\"
    
    Dim myFile As String
    myFile = Dir(myPath & "*.docx")
    
    Dim docm As Document
    Dim oTbl As Table
    Dim lRow As Long, lCol As Long
    Dim lLastRow As Long
    Do While myFile <> ""
        Set docm = Documents.Open(myPath & myFile)
        For Each oTbl In docm.Tables
            lLastRow = wrkBk.worksheets(1).Cells(1048576, 1).End(-4162).Row + 1 'Word won't understand Excel constants so -4162 = xlup
            With oTbl
                For lRow = 1 To .Rows.Count
                    For lCol = 1 To .Columns.Count
                        wrkBk.worksheets(1).Cells(lRow + lLastRow - 1, lCol) = xl.WorksheetFunction.Clean(.Cell(lRow, lCol).Range.Text)
                    Next lCol
                Next lRow
            End With
        Next oTbl
        docm.Close SaveChanges:=False
        myFile = Dir
    Loop

End Sub  

与 Excel 一样 - 设置对您正在引用的工作簿/文档的引用，而不是使用 ActiveDocument/ActiveWorkbook。