Importing Files Into Excel - Skip if not Found - vba

Question

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

Answer 1

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

Answer 2

Here:
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