Excel VBA导入错误控制

我正在使用以下代码将所有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

使用以下函数来testingWS是否已经存在：

 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