对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