开发者

Do while error control for Excel VBA Import

I'm using the following code to import all CSV files from D:\Report into Excel with each file on a new Sheet with the name of the file as the sheet name.

I'm looking to include some error control to allow the code to be run a second time if a file was not in the Report directory. The current problem is that the code will run again but bombs out as you cannot have the same name for two sheets and I dont want the same files imported again.

    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\"
strF开发者_C百科ile = 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

Any help would be greatly appreciated


Use the following function to test if a WS already exists:

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

Use it in your code like this:

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

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜