VBA routine needs error checking 1

[Delindan]

I have a VBA routine that creates an Excel spreadsheet that lists, by position number, the budgeted cost center, actual cost center and then the budget/actual/forecast for each month based on a budgeted start, actual start, forecasted start and corresponding salaries. I've got the routine working...yeah! I'm fairly new at this so it took a bit to get there. However, each time the routine encounters a record that has no position number or cost center ( budgeted or actual) it errs out. It would be nice if it would still list the information without having those pieces of information. If you need I can post the code ...Thanks!

 

[vbajock]

I need

 

[Delindan]

Option Compare Database

Private Sub cmdStartExport_Click()

Dim DB As Database
Dim xlApp As New Excel.Application
Dim RSBudget As Recordset
Dim WB As Workbook
Dim strCC As String
Dim strFolder As String
Dim strFileName As String
Dim strSheetName As String
Dim introw As Long
Dim strPosition As String
Dim strJT As String
Dim strExportTemplate As String
Dim strStart As String
Dim blnCC As Boolean
Dim blnActual As Boolean
Dim blnForecast As Boolean
Dim blnForecast2 As Boolean
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter

strStart = txtStart
strFolder = Trim(txtFolder)
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
strFileName = Trim(txtFileName)
If Right(strFileName, 5) <> ".xlsx" Then
strFileName = strFileName & ".xlsx"
End If
strFileName = strFolder & strFileName

strExportTemplate = strFolder & "Export Template.xlsx"

With xlApp
.Visible = False
Set WB = .Workbooks.Open(strExportTemplate)
.Workbooks(1).SaveAs (strFileName)
End With

txtCurrProfile = Null
DoEvents

Set DB = CurrentDb
Set qdf = DB.QueryDefs("Budget")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSBudget = qdf.OpenRecordset

txtCurrProfile = "Exporting " & strFileName & " ..."
DoEvents
xlApp.Worksheets(1).Cells(1, 2) = strStart
RSBudget.MoveFirst
strPosition = RSBudget("Position Number")
strCC = RSBudget("Budgeted CC")
strJT = RSBudget("Job Type")
introw = 4
Do Until RSBudget.EOF
xlApp.Worksheets(1).Cells(introw, 1) = RSBudget("Position Number")
xlApp.Worksheets(1).Cells(introw, 2) = RSBudget("Budgeted CC")
xlApp.Worksheets(1).Cells(introw, 4) = RSBudget("Job Type")
xlApp.Worksheets(1).Cells(introw, 5) = RSBudget("RLT Member")
xlApp.Worksheets(1).Cells(introw, 6) = RSBudget("Business Need")
xlApp.Worksheets(1).Cells(introw, 11) = RSBudget("B1")
xlApp.Worksheets(1).Cells(introw, 14) = RSBudget("B2")
xlApp.Worksheets(1).Cells(introw, 17) = RSBudget("B3")
xlApp.Worksheets(1).Cells(introw, 20) = RSBudget("B1") + RSBudget("B2") + RSBudget("B3")
xlApp.Worksheets(1).Cells(introw, 23) = RSBudget("B4")
xlApp.Worksheets(1).Cells(introw, 26) = RSBudget("B5")
xlApp.Worksheets(1).Cells(introw, 29) = RSBudget("B6")
xlApp.Worksheets(1).Cells(introw, 32) = RSBudget("B4") + RSBudget("B5") + RSBudget("B6")
xlApp.Worksheets(1).Cells(introw, 35) = RSBudget("B7")
xlApp.Worksheets(1).Cells(introw, 38) = RSBudget("B8")
xlApp.Worksheets(1).Cells(introw, 41) = RSBudget("B9")
xlApp.Worksheets(1).Cells(introw, 44) = RSBudget("B7") + RSBudget("B8") + RSBudget("B9")
xlApp.Worksheets(1).Cells(introw, 47) = RSBudget("B10")
xlApp.Worksheets(1).Cells(introw, 50) = RSBudget("B11")
xlApp.Worksheets(1).Cells(introw, 53) = RSBudget("B12")
xlApp.Worksheets(1).Cells(introw, 56) = RSBudget("B10") + RSBudget("B11") + RSBudget("B12")
xlApp.Worksheets(1).Cells(introw, 59) = RSBudget("B1") + RSBudget("B2") + RSBudget("B3") + RSBudget("B4") + RSBudget("B5") + RSBudget("B6") + RSBudget("B7") + RSBudget("B8") + RSBudget("B9") + RSBudget("B10") + RSBudget("B11") + RSBudget("B12")
blnCC = CC(strCC, introw, WB, xlApp)
introw = introw + 1
blnActual = Actual(strJT, strPosition, introw, WB, xlApp)
blnForecast = Forecast(strJT, strCC, strPosition, introw, WB, xlApp)
blnForecast2 = F2(strJT, strCC, strPosition, introw, WB, xlApp)
RSBudget.MoveNext
If RSBudget.EOF Then Exit Do
strPosition = RSBudget("Position Number")
strJT = RSBudget("Job Type")
Loop
introw = introw + 2
With xlApp
.Cells(introw, 1) = "Totals:"
.Cells(introw, 11).Formula = "=SUM(K4:" & .Cells((introw - 2), 11).Address(False, False) & ")"
.Cells(introw, 12).Formula = "=SUM(L4:" & .Cells((introw - 2), 12).Address(False, False) & ")"
.Cells(introw, 13).Formula = "=SUM(M4:" & .Cells((introw - 2), 13).Address(False, False) & ")"
.Cells(introw, 14).Formula = "=SUM(N4:" & .Cells((introw - 2), 14).Address(False, False) & ")"
.Cells(introw, 15).Formula = "=SUM(O4:" & .Cells((introw - 2), 15).Address(False, False) & ")"
.Cells(introw, 16).Formula = "=SUM(P4:" & .Cells((introw - 2), 16).Address(False, False) & ")"
.Cells(introw, 17).Formula = "=SUM(Q4:" & .Cells((introw - 2), 17).Address(False, False) & ")"
.Cells(introw, 18).Formula = "=SUM(R4:" & .Cells((introw - 2), 18).Address(False, False) & ")"
.Cells(introw, 19).Formula = "=SUM(S4:" & .Cells((introw - 2), 19).Address(False, False) & ")"
.Cells(introw, 20).Formula = "=SUM(T4:" & .Cells((introw - 2), 20).Address(False, False) & ")"
.Cells(introw, 21).Formula = "=SUM(U4:" & .Cells((introw - 2), 21).Address(False, False) & ")"
.Cells(introw, 22).Formula = "=SUM(V4:" & .Cells((introw - 2), 22).Address(False, False) & ")"
.Cells(introw, 23).Formula = "=SUM(W4:" & .Cells((introw - 2), 23).Address(False, False) & ")"
.Cells(introw, 24).Formula = "=SUM(X4:" & .Cells((introw - 2), 24).Address(False, False) & ")"
.Cells(introw, 25).Formula = "=SUM(Y4:" & .Cells((introw - 2), 25).Address(False, False) & ")"
.Cells(introw, 26).Formula = "=SUM(Z4:" & .Cells((introw - 2), 26).Address(False, False) & ")"
.Cells(introw, 27).Formula = "=SUM(AA4:" & .Cells((introw - 2), 27).Address(False, False) & ")"
.Cells(introw, 28).Formula = "=SUM(AB4:" & .Cells((introw - 2), 28).Address(False, False) & ")"
.Cells(introw, 29).Formula = "=SUM(AC4:" & .Cells((introw - 2), 29).Address(False, False) & ")"
.Cells(introw, 30).Formula = "=SUM(AD4:" & .Cells((introw - 2), 30).Address(False, False) & ")"
.Cells(introw, 31).Formula = "=SUM(AE4:" & .Cells((introw - 2), 31).Address(False, False) & ")"
.Cells(introw, 32).Formula = "=SUM(AG4:" & .Cells((introw - 2), 32).Address(False, False) & ")"
.Cells(introw, 33).Formula = "=SUM(AH4:" & .Cells((introw - 2), 33).Address(False, False) & ")"
.Cells(introw, 34).Formula = "=SUM(AI4:" & .Cells((introw - 2), 34).Address(False, False) & ")"
.Cells(introw, 35).Formula = "=SUM(AJ4:" & .Cells((introw - 2), 35).Address(False, False) & ")"
.Cells(introw, 36).Formula = "=SUM(AK4:" & .Cells((introw - 2), 36).Address(False, False) & ")"
.Cells(introw, 37).Formula = "=SUM(AL4:" & .Cells((introw - 2), 37).Address(False, False) & ")"
.Cells(introw, 38).Formula = "=SUM(AM4:" & .Cells((introw - 2), 38).Address(False, False) & ")"
.Cells(introw, 39).Formula = "=SUM(AN4:" & .Cells((introw - 2), 39).Address(False, False) & ")"
.Cells(introw, 40).Formula = "=SUM(AO4:" & .Cells((introw - 2), 40).Address(False, False) & ")"
.Cells(introw, 41).Formula = "=SUM(AP4:" & .Cells((introw - 2), 41).Address(False, False) & ")"
.Cells(introw, 42).Formula = "=SUM(AQ4:" & .Cells((introw - 2), 42).Address(False, False) & ")"
.Cells(introw, 43).Formula = "=SUM(AR4:" & .Cells((introw - 2), 43).Address(False, False) & ")"
.Cells(introw, 44).Formula = "=SUM(AS4:" & .Cells((introw - 2), 44).Address(False, False) & ")"
.Cells(introw, 45).Formula = "=SUM(AT4:" & .Cells((introw - 2), 45).Address(False, False) & ")"
.Cells(introw, 46).Formula = "=SUM(AU4:" & .Cells((introw - 2), 46).Address(False, False) & ")"
.Cells(introw, 47).Formula = "=SUM(AV4:" & .Cells((introw - 2), 47).Address(False, False) & ")"
.Cells(introw, 48).Formula = "=SUM(AW4:" & .Cells((introw - 2), 48).Address(False, False) & ")"
.Cells(introw, 49).Formula = "=SUM(AX4:" & .Cells((introw - 2), 49).Address(False, False) & ")"
.Cells(introw, 50).Formula = "=SUM(AY4:" & .Cells((introw - 2), 50).Address(False, False) & ")"
.Cells(introw, 51).Formula = "=SUM(AZ4:" & .Cells((introw - 2), 51).Address(False, False) & ")"
.Cells(introw, 52).Formula = "=SUM(BA4:" & .Cells((introw - 2), 52).Address(False, False) & ")"
.Cells(introw, 53).Formula = "=SUM(BB4:" & .Cells((introw - 2), 53).Address(False, False) & ")"
.Cells(introw, 54).Formula = "=SUM(BC4:" & .Cells((introw - 2), 54).Address(False, False) & ")"
.Cells(introw, 55).Formula = "=SUM(BD4:" & .Cells((introw - 2), 55).Address(False, False) & ")"
.Cells(introw, 56).Formula = "=SUM(BE4:" & .Cells((introw - 2), 56).Address(False, False) & ")"
.Cells(introw, 57).Formula = "=SUM(BF4:" & .Cells((introw - 2), 57).Address(False, False) & ")"
.Cells(introw, 58).Formula = "=SUM(BG4:" & .Cells((introw - 2), 58).Address(False, False) & ")"
.Cells(introw, 59).Formula = "=SUM(BH4:" & .Cells((introw - 2), 59).Address(False, False) & ")"
.Cells(introw, 60).Formula = "=SUM(BI4:" & .Cells((introw - 2), 60).Address(False, False) & ")"
.Cells(introw, 61).Formula = "=SUM(BJ4:" & .Cells((introw - 2), 61).Address(False, False) & ")"
.Workbooks(1).Save
.Workbooks(1).Close
End With

xlApp.Quit
RSBudget.Close


DB.Close

Set xlApp = Nothing
Set RSSpecialist = Nothing
Set DB = Nothing

txtCurrProfile = "Done!"
DoEvents


End Sub


Private Function Actual(strJT As String, strPosition As String, introw As Long, WB As Workbook, xlApp As Excel.Application) As Boolean

Dim DB As Database
Dim RSActual As Recordset
Dim strCost As String
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim blnCCA As Boolean


Actual = False
Set DB = CurrentDb
Set qdf = DB.QueryDefs("Actual")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSActual = qdf.OpenRecordset
RSActual.MoveFirst
Do While Not RSActual.EOF
If strPosition = RSActual("Position Number") Then
strCost = RSActual("Act Cost Center")
xlApp.Worksheets(1).Cells(introw, 1) = RSActual("Position Number")
xlApp.Worksheets(1).Cells(introw, 3) = RSActual("Act Cost Center")
xlApp.Worksheets(1).Cells(introw, 4) = strJT
xlApp.Worksheets(1).Cells(introw, 12) = RSActual("A1")
xlApp.Worksheets(1).Cells(introw, 15) = RSActual("A2")
xlApp.Worksheets(1).Cells(introw, 18) = RSActual("A3")
xlApp.Worksheets(1).Cells(introw, 21) = RSActual("A1") + RSActual("A2") + RSActual("A3")
xlApp.Worksheets(1).Cells(introw, 24) = RSActual("A4")
xlApp.Worksheets(1).Cells(introw, 27) = RSActual("A5")
xlApp.Worksheets(1).Cells(introw, 30) = RSActual("A6")
xlApp.Worksheets(1).Cells(introw, 33) = RSActual("A4") + RSActual("A5") + RSActual("A6")
xlApp.Worksheets(1).Cells(introw, 36) = RSActual("A7")
xlApp.Worksheets(1).Cells(introw, 39) = RSActual("A8")
xlApp.Worksheets(1).Cells(introw, 42) = RSActual("A9")
xlApp.Worksheets(1).Cells(introw, 45) = RSActual("A7") + RSActual("A8") + RSActual("A9")
xlApp.Worksheets(1).Cells(introw, 48) = RSActual("A10")
xlApp.Worksheets(1).Cells(introw, 51) = RSActual("A11")
xlApp.Worksheets(1).Cells(introw, 54) = RSActual("A12")
xlApp.Worksheets(1).Cells(introw, 57) = RSActual("A10") + RSActual("A11") + RSActual("A12")
xlApp.Worksheets(1).Cells(introw, 60) = RSActual("A1") + RSActual("A2") + RSActual("A3") + RSActual("A4") + RSActual("A5") + RSActual("A6") + RSActual("A7") + RSActual("A8") + RSActual("A9") + RSActual("A10") + RSActual("A11") + RSActual("A12")
blnCCA = CCA(strCost, introw, WB, xlApp)
introw = introw + 1
End If
RSActual.MoveNext
If RSActual.EOF Then Exit Do
Loop
RSActual.Close

Actual = True

End Function



Private Function Forecast(strJT As String, strCC As String, strPosition As String, introw As Long, WB As Workbook, xlApp As Excel.Application) As Boolean

Dim DB As Database
Dim RSForecast As Recordset
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim blnCC As Boolean


Forecast = False
Set DB = CurrentDb

Set qdf = DB.QueryDefs("Forecast")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSForecast = qdf.OpenRecordset

Do While Not RSForecast.EOF
If strPosition = RSForecast("Position Number") Then
xlApp.Worksheets(1).Cells(introw, 1) = RSForecast("Position Number")
xlApp.Worksheets(1).Cells(introw, 3) = strCC
xlApp.Worksheets(1).Cells(introw, 4) = strJT
xlApp.Worksheets(1).Cells(introw, 13) = RSForecast("F1")
xlApp.Worksheets(1).Cells(introw, 16) = RSForecast("F2")
xlApp.Worksheets(1).Cells(introw, 19) = RSForecast("F3")
xlApp.Worksheets(1).Cells(introw, 22) = RSForecast("F1") + RSForecast("F2") + RSForecast("F3")
xlApp.Worksheets(1).Cells(introw, 25) = RSForecast("F4")
xlApp.Worksheets(1).Cells(introw, 28) = RSForecast("F5")
xlApp.Worksheets(1).Cells(introw, 31) = RSForecast("F6")
xlApp.Worksheets(1).Cells(introw, 34) = RSForecast("F4") + RSForecast("F5") + RSForecast("F6")
xlApp.Worksheets(1).Cells(introw, 37) = RSForecast("F7")
xlApp.Worksheets(1).Cells(introw, 40) = RSForecast("F8")
xlApp.Worksheets(1).Cells(introw, 43) = RSForecast("F9")
xlApp.Worksheets(1).Cells(introw, 46) = RSForecast("F7") + RSForecast("F8") + RSForecast("F9")
xlApp.Worksheets(1).Cells(introw, 49) = RSForecast("F10")
xlApp.Worksheets(1).Cells(introw, 52) = RSForecast("F11")
xlApp.Worksheets(1).Cells(introw, 55) = RSForecast("F12")
xlApp.Worksheets(1).Cells(introw, 58) = RSForecast("F10") + RSForecast("F11") + RSForecast("F12")
xlApp.Worksheets(1).Cells(introw, 61) = RSForecast("F1") + RSForecast("F2") + RSForecast("F3") + RSForecast("F4") + RSForecast("F5") + RSForecast("F6") + RSForecast("F7") + RSForecast("F8") + RSForecast("F9") + RSForecast("F10") + RSForecast("F11") + RSForecast("F12")
blnCC = CC(strCC, introw, WB, xlApp)
introw = introw + 1
End If
RSForecast.MoveNext
Loop
RSForecast.Close
Forecast = True

End Function


Private Function CC(strCC As String, introw As Long, WB As Workbook, xlApp As Excel.Application) As Boolean

Dim DB As Database
Dim RSCCinfo As Recordset

CC = False

Set DB = CurrentDb

Set RSCCinfo = DB.OpenRecordset("Cost Center Information", dbOpenSnapshot)

Do While Not RSCCinfo.EOF
If RSCCinfo("Sap#") = strCC Then
xlApp.Worksheets(1).Cells(introw, 7) = RSCCinfo("Region")
xlApp.Worksheets(1).Cells(introw, 8) = RSCCinfo("Country")
xlApp.Worksheets(1).Cells(introw, 9) = RSCCinfo("Organization")
End If

RSCCinfo.MoveNext
If RSCCinfo.EOF Then Exit Do
Loop

CC = True

End Function




Private Function F2(strJT As String, strCC As String, strPosition As String, introw As Long, WB As Workbook, xlApp As Excel.Application) As Boolean

Dim DB As Database
Dim RSForecast2 As Recordset
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim blnCC As Boolean


F2 = False
Set DB = CurrentDb

Set qdf = DB.QueryDefs("Forecast of Actuals")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSForecast2 = qdf.OpenRecordset

Do While Not RSForecast2.EOF
If strPosition = RSForecast2("Position Number") Then
xlApp.Worksheets(1).Cells(introw, 1) = RSForecast2("Position Number")
xlApp.Worksheets(1).Cells(introw, 3) = strCC
xlApp.Worksheets(1).Cells(introw, 4) = strJT
xlApp.Worksheets(1).Cells(introw, 13) = RSForecast2("F1")
xlApp.Worksheets(1).Cells(introw, 16) = RSForecast2("F2")
xlApp.Worksheets(1).Cells(introw, 19) = RSForecast2("F3")
xlApp.Worksheets(1).Cells(introw, 22) = RSForecast2("F1") + RSForecast2("F2") + RSForecast2("F3")
xlApp.Worksheets(1).Cells(introw, 25) = RSForecast2("F4")
xlApp.Worksheets(1).Cells(introw, 28) = RSForecast2("F5")
xlApp.Worksheets(1).Cells(introw, 31) = RSForecast2("F6")
xlApp.Worksheets(1).Cells(introw, 34) = RSForecast2("F4") + RSForecast2("F5") + RSForecast2("F6")
xlApp.Worksheets(1).Cells(introw, 37) = RSForecast2("F7")
xlApp.Worksheets(1).Cells(introw, 40) = RSForecast2("F8")
xlApp.Worksheets(1).Cells(introw, 43) = RSForecast2("F9")
xlApp.Worksheets(1).Cells(introw, 46) = RSForecast2("F7") + RSForecast2("F8") + RSForecast2("F9")
xlApp.Worksheets(1).Cells(introw, 49) = RSForecast2("F10")
xlApp.Worksheets(1).Cells(introw, 52) = RSForecast2("F11")
xlApp.Worksheets(1).Cells(introw, 55) = RSForecast2("F12")
xlApp.Worksheets(1).Cells(introw, 58) = RSForecast2("F10") + RSForecast2("F11") + RSForecast2("F12")
xlApp.Worksheets(1).Cells(introw, 61) = RSForecast2("F1") + RSForecast2("F2") + RSForecast2("F3") + RSForecast2("F4") + RSForecast2("F5") + RSForecast2("F6") + RSForecast2("F7") + RSForecast2("F8") + RSForecast2("F9") + RSForecast2("F10") + RSForecast2("F11") + RSForecast2("F12")
blnCC = CC(strCC, introw, WB, xlApp)
introw = introw + 1
End If
RSForecast2.MoveNext
Loop
RSForecast2.Close
F2 = True

End Function


Private Function CCA(strCost As String, introw As Long, WB As Workbook, xlApp As Excel.Application) As Boolean

Dim DB As Database
Dim RSCCAinfo As Recordset

CCA = False

Set DB = CurrentDb

Set RSCCAinfo = DB.OpenRecordset("Cost Center Information", dbOpenSnapshot)
RSCCAinfo.MoveFirst


Do While Not RSCCAinfo.EOF
If RSCCAinfo("Sap#") = strCost Then
xlApp.Worksheets(1).Cells(introw, 7) = RSCCAinfo("Region")
xlApp.Worksheets(1).Cells(introw, 8) = RSCCAinfo("Country")
xlApp.Worksheets(1).Cells(introw, 9) = RSCCAinfo("Organization")
End If

RSCCAinfo.MoveNext
If RSCCAinfo.EOF Then Exit Do
Loop

CCA = True

End Function

 

[vbajock]

Wow. That's a lot of code.

Using the first sub you posted, at the top of your sub or function put

Private Sub cmdStartExport_Click()

On error goto err_h

At the bottom of your sub or function put

txtCurrProfile = "Done!"
DoEvents
-> exit statement
Exit Sub

-> the error hander
'******
Err_h:
'******

-> your code to handle the error.

Resume Next 'skips the line with the error and goes to the next line


End Sub


End Function

Google VBA error handling best practices for more info

 

[Delindan]

Thank you. This worked beautifully. I also googled and got additional information. Thanks again.

 

[Andrzejek]

You never stated what kind of error are you getting.
If you get a NULL in [tt]RSBudget("Position Number")[/tt] and Excel is complaining about it, you can simply do:
[tt]
xlApp.Worksheets(1).Cells(introw, 1) = RSBudget("Position Number")[blue] & ""[/blue]
[/tt]
Just add an empty string to what could be NULL and you will not get an error.

But that's just my guess about the problem you had....


Have fun.

---- Andy

 

[Delindan]

That is a wonderful tip and I will definately use it. In this case the variables it would err out on were ones that were being passed to sub routines. In most cases, when I've passed a variable to a sub routine it is because that routine will open up another table and seek information based on that value. I'm not sure if this is the downside when you send variables to a sub-routine or what. I'm new to the vba programming and had been guided to try and break processes into sub-routines and have been trying to follow that convention. Any words of wisdom on this would be great.

Thanks!

 

[JoeAtWork]

I'm not sure if this is the downside when you send variables to a sub-routine or what.

No, there's no downside to passing variables to a sub-routine. However, you do need to send it something the subroutine is expecting. For example, if it expects a number and you pass it a string, or perhaps a Null from a recordset field, you automatically are going to get an error. You must figure out what pre-conditions and assumptions are being made when you pass a variable, and sometimes do tests on the variable to make sure those assumptions are actually correct (like check if it's Null, check if it's a number, etc.).

Also, the error handler vbajock gave you is somewhat dangerous in that it assumes only one type of error will occur (a type where "resume next" would be the correct way to handle it). Based on your statement "each time the routine encounters a record that has no position number or cost center ( budgeted or actual) it errs out." I would do a more "inline" type of handling for this situation. Before using a field that may not exist, I would check if it actually does exist, and if it doesn't do whatever is appropriate. That allows you to create a more generic error handler that will take care of all other errors you did not predict.

Example:

On Error Goto ErrHandler

Dim strCost As String

'<Bunch of code that doesn't predict specific error>

'<Starting section of code that you are specifically check for
'a field that doesn't exist (let's pretend that's Error 99)>

On Error Resume Next

Err.Clear

strCost = RSActual("Act Cost Center")

If Err.Number <> 99 And Err.Number <> 0 Then
  'Whoops, don't know what this error is, send it to normal err handler
  Goto ErrHandler
End If

'Clear the error number so we can distinguish new errors
Err.Clear

'Now go back to regular error handling
On Error Goto ErrHandler

'<Bunch more code>

Exit Sub

ErrHandler:
  'Do whatever is appropriate, e.g. log the error, display it, etc.

Admitted, this is rather tedious. So my second advice is to try to avoid the predictable errors altogether. In this case, I would not write the code where a field "might" exist - I always know explicitly all fields in my recordset. If there's some value that is not always in the main query, I would look it up with a separate function. There's why breaking things up into smaller subroutines is good - it makes code easier to read and you can keep track of what specialized job the procedure you are working on is doing. As an example, I would write a specialized function whose job is to check if a field exists in a recordset:

Private Function DoesFieldExist(ByRef rs As Recordset, FieldName as String) As Boolean

Dim varWhatever As Variant
dim blnFieldExists As Boolean

On Error Resume Next

Err.Clear

varWhatever = rs(FieldName)

If Err.Number <> 99 And Err.Number <> 0 Then
  'Whoops, don't know what this error is, send it to normal err handler
  Goto ErrHandler
ElseIf Err.Number = 99 Then
  blnFieldExists = False
Else
  'No error, so the field must exist
  blnFieldExists = True
End If

'Clear the error number so we can distinguish new errors
Err.Clear

DoesFieldExist = blnFieldExists

Exit Function

ErrHandler:
  'Code to log the error
End Function

This will now reduce the original code to:

On Error Goto ErrHandler

Dim strCost As String

If DoesFieldExist(RSActual, "Act Cost Center") Then
  strCost = RSActual("Act Cost Center")
End If

'<Bunch more code>

Exit Sub

ErrHandler:
  'Do whatever is appropriate, e.g. log the error, display it, etc.

See how much easier it is to read now that the complex error checking is contained in another function? Also, the DoesFieldExist is a function you can now use in other parts of the program, instead reinventing that code every time you need it.

 

[vbajock]

I certainly had no intention of claiming "resume next" is the only code that goes into an error handler. Read the guy's post, I gave him what he asked for.

 

[JoeAtWork]

vbajock - I only wanted to give a novice a fuller understanding of error handling before we get the inevitable "my function is acting really weird and unpredictable" post.