有沒有更好的方法來遍歷和處理目錄中的文件？

Question

我有一個包含一組我希望能夠處理的文件的目錄。 一旦可以使用FSO對象獲取文件集，就可以獲取文件名，甚至可以輸出到消息框。

但是，一旦我在循環中傳遞了每個文件的完整路徑，就會遇到“ 424：需要對象”錯誤。 我想念什么嗎？ 代碼中是否有些東西沒有完全接受我的預期值。

任何幫助，將不勝感激。 非常感謝你。

更新 ：我終於意識到我的問題歸結於下面的@Dorian。 主要問題來自錯誤處理代碼。 我通常在VBA中遇到錯誤處理問題。 再次感謝。

Public Sub getAllCSVFiles()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer
Dim fileName As String

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.GetFolder(dataImportSourceLocationFolder())
On Error GoTo ErrorMessage
For Each oFile In oFolder.Files
    If InStr(oFile.Name, "csv") Then
        MsgBox (oFile)
        fileName = oFile
        If InStr(fileName, "EXTDATA1") <> 0 Then
            Call loadCSVData(fileName, "EXTDATA1")
        ElseIf InStr(fileName, "EXTDATA2") <> 0 Then
            Call loadCSVData(fileName, "EXTDATA2")
        ElseIf InStr(fileName, "EXTDATA3") <> 0 Then
            Call loadCSVData(fileName, "EXTDATA3")
        End If
    End If
Next oFile
Application.StatusBar = "File Processing Completed"
ErrorMessage:
MsgBox Err.Source & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error Importing Data"
End Sub

'This subroutine gets the csv file passed from getAllCSVs()
'
Private Sub loadCSVData(ByVal sourceFile As String, ByVal destinationWorksheet As String)
    Dim destinationCell As Range
    Dim destinationSheet As Excel.Worksheet
    On Error GoTo errMsg
    'Set destinationSheet = Worksheets("CSVDataImport") 'predefined worksheet.
    Set destinationSheet = Worksheets(destinationWorksheet)
    'Set destinationCell = destinationSheet.Range("A" & blankRow(destinationSheet))
    Set destinationCell = destinationSheet.Range("A" & blankRow(destinationSheet))
    With destinationSheet.QueryTables.Add(Connection:="TEXT;" & _
        sourceFile, Destination:=destinationCell)
        .FieldNames = False
        .RowNumbers = False
        .FieldNames = True
        .RefreshOnFileOpen = False
       .RefreshPeriod = 0
        .TextFileStartRow = 2
        .TextFileCommaDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 4, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
    End With
errMsg:
    MsgBoxErr.Description , vbCritical, Err.Number
End Sub

'This function gets the first blank row in the worksheet provided by the ws Worksheet Argument
Function blankRow(ws As Worksheet) As Long
    With ws
        blankRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    End With
End Function

'This function gets the data location by allowing the user to select
'the location of the data files

Function dataImportSourceLocationFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select the location of the CSV Files:"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    dataImportSourceLocationFolder = sItem
    Set fldr = Nothing
End Function

Answer 1

oFile是Scripting.File對象，因此您需要正確傳遞名稱。

filename = oFile.Path

如果您設置對Windows.Scripting的引用，則會發現更容易。

Dim oFSO as Scripting.FileSystemObject
Set oFSO = New Scripting.FileSystemObject
Dim oFile as Scripting.File

這樣您便可以看到oFile對象的屬性。

Answer 2

嘗試一下，您在代碼中犯了一些錯誤，但是現在我面臨內存問題，可能是因為我沒有好的.csv文件...

我正在等待您的反饋！

Public Sub getAllCSVFiles()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer
Dim fileName As String

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.GetFolder(dataImportSourceLocationFolder())
On Error GoTo ErrorMessage
For Each oFile In oFolder.Files
Debug.Print oFile.Name
    If InStr(oFile.Name, "csv") Then
        MsgBox (oFile)
        fileName = oFile
        If InStr(fileName, "EXTDATA1") <> 0 Then
            Call loadCSVData(fileName, "EXTDATA1")
        ElseIf InStr(fileName, "EXTDATA2") <> 0 Then
            Call loadCSVData(fileName, "EXTDATA2")
        ElseIf InStr(fileName, "EXTDATA3") <> 0 Then
            Call loadCSVData(fileName, "EXTDATA3")
        End If
    End If
Next oFile
Application.StatusBar = "File Processing Completed"
ErrorMessage:
MsgBox Err.Source & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error Importing Data"
End Sub

'This subroutine gets the csv file passed from getAllCSVs()
'
Private Sub loadCSVData(ByVal sourceFile As String, ByVal destinationWorksheet As String)
    Dim destinationCell As Range
    Dim destinationSheet As Excel.Worksheet
    'On Error GoTo errMsg
    'Set destinationSheet = Worksheets("CSVDataImport") 'predefined worksheet.
    Set destinationSheet = Worksheets(destinationWorksheet)
    Debug.Print blankRow(destinationSheet)
    Set destinationCell = destinationSheet.Range("A" & blankRow(destinationSheet))
    With destinationSheet.QueryTables.Add(Connection:="TEXT;" & _
        sourceFile, Destination:=destinationCell)
        .FieldNames = False
        .RowNumbers = False
        .FieldNames = True
        .RefreshOnFileOpen = False
       .RefreshPeriod = 0
        .TextFileStartRow = 2
        .TextFileCommaDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 4, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
    End With
errMsg:
    MsgBoxErr.Description , vbCritical, Err.Number
End Sub

'This function gets the first blank row in the worksheet provided by the ws Worksheet Argument
Function blankRow(ws As Worksheet) As Long
    With ws
        blankRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    End With
End Function

'This function gets the data location by allowing the user to select
'the location of the data files
Function dataImportSourceLocationFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select the location of the CSV Files:"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1) & "\"
    End With
NextCode:
    dataImportSourceLocationFolder = sItem
    Set fldr = Nothing
End Function