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
精彩评论