自动选择所有文件excel宏

Question

I have the following code which is at the tail end of a long process. This part looks in a directory for the files that were created. Everything works fine but I am trying to eliminate user input. The problem is the GetOpenFilename causes a pop up. How can I make the code just automatically select all the files in the directory. I have tried manually entering the path but it exits out with is not array.

**Editing this for full code because something I left out of the for loop is throwing an error once I get the file names

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

If I add something like this in to grab the filenames

strPath = "C:\test\ "  

Set objFolder = FSO.GetFolder(strPath)  

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

Once I do the for each I get a runtime error 13 object mismtatch on ths line

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

It seems once I grab the file names via a variable the my old method of Application.GetOpenFileName being gone no longer allows me to open the Word Doc to import the tables.

Answer 1

Try below code

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)

After the above commands, fileNames will have all the word document file names.

Source : http://www.exceltrick.com/formulas_macros/filesystemobject-in-vba/