Getting runtime error 5 near the end of function

Question

I inherited some VBA for dumping emails from a folder in Outlook into a SQL database. I have the first Sub() working, but the function below when I run the script gives me a "VBA Runtime Error 5". I am not able to figure out why it is throwing the error and it looks like a generic error. I would like assistance in debugging this. The error is with the line (6 rows from the bottom): GetText = Replace(Trim(Mid(body, s + l, ml)), "'", "''")

Below is the whole function. Is there anything glaring that I am missing?

Function GetText(ByVal body As String, ByVal start_ As String, ByVal end_ As String, ByVal maxlength As Double) As String
'return the text in the range, less the start_ text itself.  Also checks for "--- End Of Report ---" in addition to the end_ value.
'returns '' if not found
'limit size to maxlength, unless it is -1 which means no limit
Dim l, s, e, ml As Double
GetText = ""
'check that we have the starting value
s = InStr(1, body, start_)
 
If s > 0 Then
 
    l = Len(start_)
    'get the location of the end_.  If 0, get End Of Report location
    e = InStr(1, body, end_)
    If e = 0 Then
    Select Case start_
    Case "ADDRESS:", "NETWORK:", "EMAIL:"
        end_ = "SECURITY TYPE:"
    Case "USER:"
        end_ = "EMAIL:"
    Case "DISK:"
        end_ = "CULTURE:"
    Case "CULTURE:"
        end_ = "USER:"
    Case "OS:"
        end_ = "CLR:"
    Case "HARDWARE:"
        end_ = "ENVIRONMENT:"
    Case "XMR:"
        end_ = "CPU:"
    Case "ARGS:"
        end_ = "RIGHTS:"
    Case "MEMORY:", "ENVIRONMENT:"
        end_ = "DISK:"
    Case "BUILD:"
        end_ = "HARDWARE:"
    Case "!!!EXCEPTION ENCOUNTERED!!!"
        end_ = "--- End Of Report ---"
    End Select
    e = InStr(1, body, end_)
        If e = 0 Then
            Select Case start_
                Case "USER:"
                    end_ = "SECURITY TYPE:"
                Case "HARDWARE:"
                    end_ = "MEMORY:"
                Case "CULTURE:", "EMAIL:", "NETWORK:"
                    end_ = "SECURITY:"
            End Select
            e = InStr(1, body, end_)
            If e = 0 Then
            Select Case start_
                Case "HARDWARE:"
                    end_ = "DISK:"
                Case "USER:"
                    end_ = "SECURITY:"
            End Select
            e = InStr(1, body, end_)
        End If
        End If
    End If
   
    
    If e = 0 Then
        e = InStr(1, body, "!!!EXCEPTION ENCOUNTERED!!!")
        If e = 0 Then e = InStr(1, body, "--- End Of Report ---")
    End If
    ml = e - s - l 'the length of the returning text
    If maxlength > -1 And ml > maxlength Then
      '  MsgBox "Hit"
        ml = maxlength
    End If
 
    GetText = Replace(Trim(Mid(body, s + l, ml)), "'", "''")
    If ml = 1000000 Then
        GetText = GetText & "[truncated]"
    End If
End If
 
 
End Function

Have you tried declaring s, l, and ml as a *Long* data type instead of Double? I know the value would be the same but it may be that the Mid() function doesn't accept a double data type for the argument(s). — SierraOscar, Nov 18 '14 at 22:41
Unfortunately that didn't take care of the issue. I appreciate the response though. — Slyce, Nov 18 '14 at 22:53
Okay, have you checked the Locals window to see what the value of s, l, and ml are at the point of the error? — SierraOscar, Nov 18 '14 at 23:05
ml= -268. I was able to get around this by just statically setting the value to 10000. Now I am getting command timeout errors with my OODBC connection. I should be able to resolve those though. Thanks for your help! — Slyce, Nov 19 '14 at 00:09
@SO - When declared as `Dim l, s, e, ml As Double`, *l, s* & *e* are declared as `Variant`. Only *ml* is assigned the `Double` type. — , Nov 19 '14 at 05:02
@Jeeped Yes, I know thanks - I was hinting at the possibility that the values of l/s/ml may not be what he was expecting when trying to subtract one from the other in his Mid() function. Even when not explicitly declared as a data type it should still be converted to type Variant/Long or Variant/Double and therefore still work with the function. Looks like it is just a calculation error earlier on in the code though! — SierraOscar, Nov 19 '14 at 09:22

score 0 · Answer 1 · answered Nov 19 '14 at 05:45

I made some code changes, primarily to do with looking for end_ after the start_ text's ending position. Also added some Case Else that should be coded for worse case scenarios. Perhaps you can slip a Debug.Print into those to see how things are processign through the sequence of trying to get an appropriate end_ for your start_.

Function GetText(ByVal bdy As String, ByVal start_ As String, ByVal end_ As String, ByVal mxlength As Long) As String
    Dim l As Long, s As Long, e As Long, ml As Long
    'GetText = "" unnecessary and GetText = vbnullstring would be better

    s = InStr(1, bdy, start_, vbTextCompare)  'case insensitive just-in-case
    If CBool(s) Then
        l = Len(start_)
        e = InStr(l + s, bdy, end_, vbTextCompare) 'start looking AFTER the start_ text
        If Not CBool(e) Then    'I prefer booleans instead of e = 0
            Select Case UCase(start_)   'UCase just to be sure
                Case "ADDRESS:", "NETWORK:", "EMAIL:"
                    end_ = "SECURITY TYPE:"
                Case "USER:"
                    end_ = "EMAIL:"
                Case "DISK:"
                    end_ = "CULTURE:"
                Case "CULTURE:"
                    end_ = "USER:"
                Case "OS:"
                    end_ = "CLR:"
                Case "HARDWARE:"
                    end_ = "ENVIRONMENT:"
                Case "XMR:"
                    end_ = "CPU:"
                Case "ARGS:"
                    end_ = "RIGHTS:"
                Case "MEMORY:", "ENVIRONMENT:"
                    end_ = "DISK:"
                Case "BUILD:"
                    end_ = "HARDWARE:"
                Case "!!!EXCEPTION ENCOUNTERED!!!"
                    end_ = "--- End Of Report ---"
                Case Else
                    end_ = "--- End Of Report ---"  'should always have a worse-case plan
            End Select
        End If
        If Not CBool(e) Then _
            e = InStr(l + s, bdy, end_, vbTextCompare)  ' again, start looking for end_ AFTER start_
        If Not CBool(e) Then
            Select Case start_
                Case "USER:"
                    end_ = "SECURITY TYPE:"
                Case "HARDWARE:"
                    end_ = "MEMORY:"
                Case "CULTURE:", "EMAIL:", "NETWORK:"
                    end_ = "SECURITY:"
                Case Else
                    end_ = "--- End Of Report ---"  'should always have a worse-case plan
            End Select
        End If
        If Not CBool(e) Then _
            e = InStr(l + s, bdy, end_, vbTextCompare)  ' again, start looking for end_ AFTER start_
        If Not CBool(e) Then
            Select Case start_
                Case "HARDWARE:"
                    end_ = "DISK:"
                Case "USER:"
                    end_ = "SECURITY:"
                Case Else
                    end_ = "--- End Of Report ---"  'should always have a worse-case plan
            End Select
        End If
        If Not CBool(e) Then _
            e = InStr(l + s, bdy, end_, vbTextCompare)  ' again, start looking for end_ AFTER start_
        If Not CBool(e) Then
            e = InStr(1, bdy, "!!!EXCEPTION ENCOUNTERED!!!", vbTextCompare) 'look for this from the very start
            If Not CBool(e) Then _
                e = InStr(l + s, bdy, "--- End Of Report ---", vbTextCompare)  ' again, start looking for end_ AFTER start_
        End If
        ml = e - (l + s) 'the length of the returning text
        If mxlength > -1 And ml > mxlength Then
          '  MsgBox "Hit"
            ml = mxlength
        End If
        'you didn't calculate on trimmed text so don't trim until after the Mid parse
        GetText = Trim(Replace(Mid(bdy, s + l, ml), "'", "''"))
        If ml = 1000000 Then
            GetText = GetText & "[truncated]"
        End If
    End If

End Function

This is a tough nut to crack without seeing a sample body being thrust into the function but perhaps this will lead you to a resolution.

score 0 · Accepted Answer · answered Nov 19 '14 at 09:16

Invalid procedure call or argument (Error 5) could mean for example that an argument exceeds the range of permitted values.

"I would like assistance in debugging this"

To find the error you could split the line which is causing the error into separate calls and see which function caused the error. Then watch the arguments which was used in the call that caused the error.

Dim s As Long
Dim l As Long
Dim ml As Long

Dim bodyPart As String
bodyPart = Mid(body, s + l, ml)

Dim bodyPartTrimmed As String
bodyPartTrimmed = Trim(bodyPart)

Dim bodyPartTrimmedFinal As String
bodyPartTrimmedFinal = Replace(bodyPartTrimmed, "'", "''")

GetText = bodyPartTrimmedFinal

What you can do as well is to verify the arguments before the function is called. For example for Mid function:

Dim bodyPart As String
If (s + l) <= 0 Then _
    Err.Raise 5, , "Invalid arguments for Mid function. Start position must be greater then zero"

If ml < 0 Then _
    Err.Raise 5, , "Invalid arguments for Mid function. Length must be greater then or equal to zero"

bodyPart = Mid(body, s + l, ml)

Getting runtime error 5 near the end of function

2 Answers2