Question

我正在使用以下代码将所有CSV文件从D：\ Report导入到Excel中，每个文件都放在一个新工作表上，文件名称作为工作表名称。

我希望包含一些错误控制，以便在文件不在Report目录中时允许代码第二次运行。目前的问题是代码将再次运行，但因为两张纸的名称不同而炸弹，我不希望再次导入相同的文件。

    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

执行Excel VBA导入时的错误控制

1 个答案: