在回路中的vba错误处理
vba的新手,试图'错误转到',但是,我不断收到错误'索引超出范围'。在回路中的vba错误处理
我只想制作一个由包含查询表的工作表名称填充的组合框。
For Each oSheet In ActiveWorkbook.Sheets
On Error GoTo NextSheet:
Set qry = oSheet.ListObjects(1).QueryTable
oCmbBox.AddItem oSheet.Name
NextSheet:
Next oSheet
我不确定问题是否与在循环中嵌套On Error GoTo或如何避免使用循环相关。
这个问题可能是你还没有从第一个错误恢复。您不能在错误处理程序中抛出错误。您应该添加在简历中声明,类似于以下,所以VBA不再认为你是在错误处理程序中:
For Each oSheet In ActiveWorkbook.Sheets
On Error GoTo NextSheet:
Set qry = oSheet.ListObjects(1).QueryTable
oCmbBox.AddItem oSheet.Name
NextSheet:
Resume NextSheet2
NextSheet2:
Next oSheet
如何:
For Each oSheet In ActiveWorkbook.Sheets
If oSheet.ListObjects.Count > 0 Then
oCmbBox.AddItem oSheet.Name
End If
Next oSheet
这
On Error GoTo NextSheet:
应该是:
On Error GoTo NextSheet
的其他解决办法也很好。
我可以帮助你,我在我的“图书馆”有以下功能。既然它是我在网上发现的功能和功能的组合,我不太确定那个功能是从哪里来的。
Function GetTabList(Optional NameSpec As String = "*", _
Optional wkb As Workbook = Nothing) As Variant
' Returns an array of tabnames that match NameSpec
' If no matching tabs are found, it returns False
Dim TabArray() As Variant
Dim t As Worksheet
Dim i As Integer
On Error GoTo NoFilesFound
If wkb Is Nothing Then Set wkb = ActiveWorkbook
ReDim TabArray(1 To wkb.Worksheets.Count)
i = 0
' Loop until no more matching tabs are found
For Each t In wkb.Worksheets
If UCase(t.Name) Like UCase(NameSpec) Then
i = i + 1
TabArray(i) = t.Name
End If
Next t
ReDim Preserve TabArray(1 To i)
GetTabList = TabArray
Exit Function
' Error handler
NoFilesFound:
GetTabList = False
End Function
至于处理错误在喜欢你的示例代码回路一般的方式,我宁愿使用:
on error resume next
for each...
'do something that might raise an error, then
if err.number <> 0 then
...
end if
next ....
怎么样?
If oSheet.QueryTables.Count > 0 Then
oCmbBox.AddItem oSheet.Name
End If
或者
If oSheet.ListObjects.Count > 0 Then
'// Source type 3 = xlSrcQuery
If oSheet.ListObjects(1).SourceType = 3 Then
oCmbBox.AddItem oSheet.Name
End IF
End IF
Actualy的加宾史密斯的答案需要修改一下工作,因为你可以”继续而没有错误。
Sub MyFunc()
...
For Each oSheet In ActiveWorkbook.Sheets
On Error GoTo errHandler:
Set qry = oSheet.ListObjects(1).QueryTable
oCmbBox.AddItem oSheet.name
...
NextSheet:
Next oSheet
...
Exit Sub
errHandler:
Resume NextSheet
End Sub
还有另一种控制错误处理的方法,可以很好地处理循环。创建一个名为here
的字符串变量,并使用该变量确定单个错误处理程序如何处理错误。
的代码模板是:
On error goto errhandler
Dim here as String
here = "in loop"
For i = 1 to 20
some code
Next i
afterloop:
here = "after loop"
more code
exitproc:
exit sub
errhandler:
If here = "in loop" Then
resume afterloop
elseif here = "after loop" Then
msgbox "An error has occurred" & err.desc
resume exitproc
End if
我不想手艺特殊的错误处理程序在我的代码每次循环结构,所以我必须找到问题的办法用我的标准错误处理回路,让我能然后为它们写一个特殊的错误处理程序。
如果在循环中发生错误,我通常想知道导致错误的原因,而不是跳过它。为了找出这些错误,我和许多人一样将错误消息写入日志文件。但是,如果在循环中发生错误,写入日志文件是很危险的,因为每次循环迭代时都会触发错误,在我的情况下,80 000次迭代并不少见。因此,我将一些代码放入错误日志记录函数中,以检测相同的错误并跳过将它们写入错误日志。
我在每个过程中使用的标准错误处理程序如下所示。它记录错误类型,发生错误的过程以及过程收到的任何参数(本例中为FileType)。
procerr:
Call NewErrorLog(Err.number, Err.Description, "GetOutputFileType", FileType)
Resume exitproc
写入表(我在ms-access中)的错误记录函数如下。它使用静态变量保留以前的错误数据值并将它们与当前版本进行比较。记录第一个错误,然后第二个相同的错误将应用程序推入调试模式,如果我是用户或者在其他用户模式下退出应用程序。
Public Function NewErrorLog(ErrCode As Variant, ErrDesc As Variant, Optional Source As Variant = "", Optional ErrData As Variant = Null) As Boolean
On Error GoTo errLogError
'Records errors from application code
Dim dbs As Database
Dim rst As Recordset
Dim ErrorLogID As Long
Dim StackInfo As String
Dim MustQuit As Boolean
Dim i As Long
Static ErrCodeOld As Long
Static SourceOld As String
Static ErrDataOld As String
'Detects errors that occur in loops and records only the first two.
If Nz(ErrCode, 0) = ErrCodeOld And Nz(Source, "") = SourceOld And Nz(ErrData, "") = ErrDataOld Then
NewErrorLog = True
MsgBox "Error has occured in a loop: " & Nz(ErrCode, 0) & Space(1) & Nz(ErrDesc, "") & ": " & Nz(Source, "") & "[" & Nz(ErrData, "") & "]", vbExclamation, Appname
If Not gDeveloping Then 'Allow debugging
Stop
Exit Function
Else
ErrDesc = "[loop]" & Nz(ErrDesc, "") 'Flag this error as coming from a loop
MsgBox "Error has been logged, now Quiting", vbInformation, Appname
MustQuit = True 'will Quit after error has been logged
End If
Else
'Save current values to static variables
ErrCodeOld = Nz(ErrCode, 0)
SourceOld = Nz(Source, "")
ErrDataOld = Nz(ErrData, "")
End If
'From FMS tools pushstack/popstack - tells me the names of the calling procedures
For i = 1 To UBound(mCallStack)
If Len(mCallStack(i)) > 0 Then StackInfo = StackInfo & "\" & mCallStack(i)
Next
'Open error table
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("tbl_ErrLog", dbOpenTable)
'Write the error to the error table
With rst
.AddNew
!ErrSource = Source
!ErrTime = Now()
!ErrCode = ErrCode
!ErrDesc = ErrDesc
!ErrData = ErrData
!StackTrace = StackInfo
.Update
.BookMark = .LastModified
ErrorLogID = !ErrLogID
End With
rst.Close: Set rst = Nothing
dbs.Close: Set dbs = Nothing
DoCmd.Hourglass False
DoCmd.Echo True
DoEvents
If MustQuit = True Then DoCmd.Quit
exitLogError:
Exit Function
errLogError:
MsgBox "An error occured whilst logging the details of another error " & vbNewLine & _
"Send details to Developer: " & Err.number & ", " & Err.Description, vbCritical, "Please e-mail this message to developer"
Resume exitLogError
End Function
注意,错误记录器必须处于您的应用程序的应用程序无法正常在错误日志错误处理的最子弹校对功能。出于这个原因,我使用NZ()来确保空值不能潜入。注意,我还将[loop]添加到第二个相同的错误,以便我知道首先在错误过程中查找循环。
不存在不是查询表的“列表对象”吗?我需要该工作表有一个查询表。 –
@Justin,如果是这样,为'ListObjects(1).QueryTable Is Nothing'添加一个测试 - 你的代码也没有这个测试。我的示例的主要观点是在取消引用第一个元素之前检查ListObjects集合是否具有任何元素。 – Joe