對Excel VBA導入

Question

執行錯誤控制時我使用以下代碼將所有CSV文件從D：\ Report導入到Excel中，並將新文件夾中的每個文件與文件名稱作爲工作表名稱。

我正在尋找包括一些錯誤控制來允許代碼再次運行，如果文件不在報告目錄中。目前的問題是，代碼將再次運行，但炸彈出，因爲你不能爲兩張表具有相同的名稱，我不想再次導入相同的文件。

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 

任何幫助，將不勝感激

Answer 1

Use the following function測試如果WS已經存在：

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 

用它在你的代碼是這樣的：

.... 
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