Question

我有以下代码，它位于漫长过程的尾端。此部分在目录中查找已创建的文件。一切正常，但我试图消除用户输入。问题是GetOpenFilename会导致弹出窗口。如何让代码自动选择目录中的所有文件。我已尝试手动输入路径，但它退出时不是数组。

**为完整代码编辑此代码，因为我从for循环中遗漏的内容在我获取文件名后抛出错误

Option Explicit

Sub A_ImportWordTable()

Dim WordApp As Object
Dim wdDoc As Object
Dim wdFileName As Variant, FileName 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
Dim resultRow As Long
Dim tableStart As Integer
Dim tableTot As Integer

On Error Resume Next

ActiveSheet.Range("A:AZ").ClearContents

*******I want to pull this out and grab the file names*******
 wdFileName = Application.GetOpenFilename("Word files (*.doc; *.docx),*.doc;*.docx", 2, _
                                              "Browse for file containing table to be imported", , True)
***********

If Not IsArray(wdFileName) Then Exit Sub   '(user cancelled import file browser)
Set WordApp = CreateObject("Word.Application")
'WordApp.Visible = True

For Each FileName In wdFileName
  Set wdDoc = WordApp.Documents.Open(FileName, ReadOnly:=True)

  With wdDoc
    tableNo = wdDoc.tables.Count
    tableTot = wdDoc.tables.Count
    If tableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    End If

    For tableStart = 2 To tableTot
        With .tables(tableStart)
            'copy cell contents from Word table cells to Excel cells
            For iRow = 1 To .Rows.Count
                For iCol = 1 To .Columns.Count
                    Cells(resultRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                 Next iCol
                resultRow = resultRow + 1
            Next iRow
        End With
        resultRow = resultRow + 1
    Next tableStart
  End With
  'file eof code
    Dim LastRow As Long, ws As Worksheet

    Set ws = Sheets("Sheet1")

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row

    ws.Range("A" & LastRow).Value = "EOF A" 'Adds the TextBox3 into Col A & Last Blank Row
    ws.Range("B" & LastRow).Value = "999" 'Adds the ComboBox1 into Col B & Last Blank Row
    ws.Range("C" & LastRow).Value = "777" 'Adds the TextBox3 into Col A & Last Blank Row
    ws.Range("D" & LastRow).Value = "EOF D" 'Adds the ComboBox1 into Col B & Last Blank Row
    ws.Range("E" & LastRow).Value = "EOF E" 'Adds the TextBox3 into Col A & Last Blank Row
    ws.Range("F" & LastRow).Value = "EOF F" 'Adds the ComboBox1 into Col B & Last Blank Row
    'end code
Next FileName

End Sub

如果我添加这样的内容来获取文件名

strPath = "C:\test\ "  

Set objFolder = FSO.GetFolder(strPath)  

If objFolder.Files.Count = 0 Then  
 MsgBox "No files were found...", vbExclamation  
 Exit Sub  
End If

一旦我为每个人做了一次运行时错误13对象mismtatch就行了

Set wdDoc = WordApp.Documents.Open(FileName, ReadOnly:=True)

似乎一旦我通过变量获取文件名，我的旧方法Application.GetOpenFileName就不再允许我打开Word Doc来导入表格了。

Answer 1

尝试以下代码

Dim strPath
Dim fileNames()
strPath = "C:\Users\..." 'your folder path here
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder(strPath)
ReDim fileNames(objFolder.Files.Count)
i = 0
For Each file In objFolder.Files
If file.Type = "Microsoft Word Document" Then
fileNames(i) = file.Name
i = i + 1
End If
Next
ReDim Preserve fileNames(i)

在上述命令之后，fileNames将包含所有word文档文件名。

来源：http://www.exceltrick.com/formulas_macros/filesystemobject-in-vba/

自动选择所有文件excel宏

一旦我为每个人做了一次运行时错误13对象mismtatch就行了

1 个答案: