对 Excel VBA 导入进行错误控制
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/4399668/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Do while error control for Excel VBA Import
提问by Adam
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.
我使用以下代码将所有 CSV 文件从 D:\Report 导入 Excel,每个文件都位于新工作表上,文件名作为工作表名称。
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.
如果文件不在 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
Any help would be greatly appreciated
任何帮助将不胜感激
回答by Dr. belisarius
Use the following functionto test if a WS already exists:
使用以下函数来测试 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
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