Faire tout contrôle d'erreur pour Excel Importation VBA

Question

J'utilise le code suivant pour importer tous les fichiers CSV de D: \ Report dans Excel avec chaque fichier d'une nouvelle feuille avec le nom du fichier comme nom de feuille.

Je cherche à inclure un contrôle d'erreur pour permettre au code d'être exécuté une deuxième fois si un fichier ne se trouvait pas dans le répertoire Report. Le problème actuel est que le code s'exécutera à nouveau mais les bombes sortiront car vous ne pouvez pas avoir le même nom pour deux feuilles et je ne veux pas que les mêmes fichiers soient importés à nouveau.

Sub ImportAllReportData() 
' 
' Import All Report Data 
' All files in D:\Report will be imported and added to seperate sheets using the file names in UPPERCASE 
' 
Dim strPath As String 
Dim strFile As String 
' 
strPath = "D:\New\" 
strFile = Dir(strPath & "*.csv") 
Do While strFile <> "" 
    With ActiveWorkbook.Worksheets.Add 
     With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _ 
     Destination:=.Range("A1")) 
     .Parent.Name = Replace(UCase(strFile), ".CSV", "") 
     .TextFileParseType = xlDelimited 
     .TextFileTextQualifier = xlTextQualifierDoubleQuote 
     .TextFileConsecutiveDelimiter = False 
     .TextFileTabDelimiter = False 
     .TextFileSemicolonDelimiter = False 
     .TextFileCommaDelimiter = True 
     .TextFileSpaceDelimiter = False 
     .TextFileColumnDataTypes = Array(1) 
     .TextFileTrailingMinusNumbers = True 
     .Refresh BackgroundQuery:=False 
     End With 
    End With 
strFile = Dir 
Loop 
End Sub 

Toute aide serait grandement appréciée

Answer 1

Use the following function pour tester si une WS existe déjà:

Function SheetExists(strShtName As String) As Boolean 
Dim ws As Worksheet 
    SheetExists = False 'initialise 
    On Error Resume Next 
    Set ws = Sheets(strShtName) 
    If Not ws Is Nothing Then SheetExists = True 
    Set ws = Nothing 'release memory 
    On Error GoTo 0 
End Function 

Utilisez dans votre code comme ceci:

.... 
strPath = "D:\New\" 
strFile = Dir(strPath & "*.csv") 
Do While strFile <> "" 
    If Not SheetExists(Replace(UCase(strFile), ".CSV", "")) Then 

     With ActiveWorkbook.Worksheets.Add 
     With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _ 
     ..... 
    End If