Search code examples
vbaexcelonerror

Importing Files Into Excel - Skip if not Found


This is my first question here, I have a macro to import .txt files "Semicolon" delimited into Excel. Each file is name specific, and each file is imported in a new sheet. But if one of theses files doesn't exists, the macro Fails. I want to add an "On Erro" to handle these cases, if the file doesn't exists, skip it. Heres the code:

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

Solution

  • Here is your code with the check if the file exist:

    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
    

    Like in your comment, if you want to run through all files that have a certain name in common (a filter), you can use this code. The above modifications have then became useless because with this you don't have to check if file exists anymore since it will just go through all existing files. You could have to check if the folder exists though:

    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
    

    For more information see Dir, FileExists and FolderExists