将文件导入 Excel - 如果找不到则跳过

Question

这是我的第一个问题，我有一个宏可以将“分号”分隔的 .txt 文件导入 Excel。每个文件都有特定的名称，并且每个文件都被导入到一个新工作表中。但是，如果这些文件之一不存在，则宏将失败。我想添加一个“On Erro”来处理这些情况，如果文件不存在，请跳过它。代码如下：

Sub Importar_Dep()

Dim Caminho As String


Caminho = Sheets("DADOS").Cells(5, 8).Value
    Sheets("DEP").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Caminho, _
        Destination:=Range("$A$1"))
        .Name = "RECONQUISTA_DEP_0"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Answer 1

这是检查文件是否存在的代码：

Sub Importar_Dep()

    Dim Caminho As String
    Caminho = Sheets("DADOS").Cells(5, 8).Value
    Sheets("DEP").Select

    '+++++ Added block to check if file exists +++++
    Dim FS
    Set FS = CreateObject("Scripting.FileSystemObject")

    Dim TextFile_FullPath As String
    'The textfile_fullPath should be like:
    TextFile_FullPath = "C:\Users\Username\Desktop\" & _
                         RECONQUISTA_DEP_0 & _
                         ".txt"

    If FS.FileExists(TextFile_FullPath) Then
    '++++++++++++++++++++++++++++++++++++++++++++++++
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & Caminho, _
            Destination:=Range("$A$1"))
            .Name = "RECONQUISTA_DEP_0"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = True
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

    End If

End Sub

就像在您的评论中一样，如果您想遍历所有具有特定名称的文件（过滤器），您可以使用此代码。然后上述修改变得无用，因为这样您就不必再检查文件是否存在，因为它只会遍历所有现有文件。您可能必须检查该文件夹是否存在：

Sub RunThroughAllFiles()

    Dim Caminho As String
    Caminho = Sheets("DADOS").Cells(5, 8).Value
    Sheets("DEP").Select

    Dim FS
    Set FS = CreateObject("Scripting.FileSystemObject")

    Dim Filter As String: Filter = "RECONQUISTA_DEP_*.txt"
    Dim dirTmp As String

    If FS.FolderExists(Caminho) Then
        dirTmp = Dir(Caminho & "\" & Filter)
        Do While Len(dirTmp) > 0
            Call Importar_Dep(Caminho & "\" & dirTmp, _
                            Left(dirTmp, InStrRev(dirTmp, ".") - 1))
            dirTmp = Dir
        Loop
    Else
        MsgBox "Folder """ & Caminho & """ does not exists", vbExclamation
    End If

End Sub

Sub Importar_Dep(iFullFilePath As String, iFileNameWithoutExtension)

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & iFullFilePath, _
        Destination:=Range("$A$1"))
        .Name = iFileNameWithoutExtension
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

End Sub

如需了解更多信息，请参阅Dir、FileExists 和FolderExists

Answer 2

这里：

Sub Abrir_PORT()

    Dim Caminho As String
    Caminho = Sheets("DADOS").Cells(5, 5).Value
    Sheets("PORT").Select

    Dim FS
    Set FS = CreateObject("Scripting.FileSystemObject")

    Dim Filter As String: Filter = "ATENTO_TLMKT_REC*.txt"
    Dim dirTmp As String

    If FS.FolderExists(Caminho) Then
        dirTmp = Dir(Caminho & "\" & Filter)
        Do While Len(dirTmp) > 0
            Call Importar_PORT(Caminho & "\" & dirTmp, _
                            Left(dirTmp, InStrRev(dirTmp, ".") - 1))
            dirTmp = Dir
        Loop
    End If

End Sub

Sub Importar_PORT(iFullFilePath As String, iFileNameWithoutExtension)

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & iFullFilePath, _
        Destination:=Range("$A$1"))
        .Name = iFileNameWithoutExtension
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False

    iRow = 2

    Do While Sheets("PORT").Cells(iRow, 1) <> ""

                If Cells(iRow, 2) = IsNumber Then

                Else

                Rows(iRow).Select
                Selection.EntireRow.Delete

                iRow = iRow - 1
                contagem = contagem + 1

                End If

 iRow = iRow + 1

 Loop

    End With

End Sub