Question

我有一个VBA代码，可将单词表转换为excel工作表：

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel

wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    TableNo = wdDoc.tables.count
    If TableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf TableNo > 1 Then
        TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
        "Enter table number of table to import", "Import Word Table", "1")
    End If
    With .tables(TableNo)
        'copy cell contents from Word table cells to Excel cells
        For iRow = 1 To .Rows.count
            For iCol = 1 To .Columns.count
                Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
            Next iCol
        Next iRow
    End With
End With

Set wdDoc = Nothing

End Sub

该代码会提示您选择要转换的Word文档。我的文件夹中有几个Word文档，我想创建一个for循环，该循环将每个Word文档转换为新的Excel文件。

Answer 1

您只需要将发布的代码与代码here

结合起来

Sub RunThroughFolder()

Dim folderName As String
Dim fileName As String

    folderName = GetFolder
    fileName = Dir(folderName & "\*.docx")

    Do While fileName <> ""
        Debug.Print fileName
        ImportWordTable folderName & "\" & fileName
        fileName = Dir
    Loop

End Sub

您需要稍微修改发布的代码

Sub ImportWordTable(wdFileName As String)
Dim wdDoc As Object
'Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel

'wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
'"Browse for file containing table to be imported")

'If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    TableNo = wdDoc.tables.Count
    If TableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf TableNo > 1 Then
        TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
        "Enter table number of table to import", "Import Word Table", "1")
    End If
    With .tables(TableNo)
        'copy cell contents from Word table cells to Excel cells
        For iRow = 1 To .Rows.Count
            For iCol = 1 To .Columns.Count
                Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
            Next iCol
        Next iRow
    End With
End With

Set wdDoc = Nothing

End Sub

如何为VBA代码创建循环以在多个文档上运行？

1 个答案: