我继承了一些VBA，用于将Outlook中文件夹中的电子邮件转储到SQL数据库中。我有第一个Sub（）工作，但是当我运行脚本时，下面的函数给了我一个＆＃34; VBA运行时错误5＆＃34;。我无法弄清楚为什么它会抛出错误，它看起来像一般错误。我想帮助调试这个。错误与行（从底部6行）： GetText =替换（修剪（中（身体，s + l，ml）），＆＃34;＆＃39;＆＃34;，＆＃34;＆＃39;＆＃39;＆＃34;）
以下是整个功能。有什么东西明显我错过了吗？
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
答案 0 :(得分：0)
我做了一些代码更改，主要是为了在 start_ text的结束位置之后查找end_ 。还添加了一些Case Else，应该针对更糟糕的情况进行编码。也许你可以将Debug.Print放到那些内容中，看看事情是如何通过尝试为你的开始获得一个合适的结束_的顺序进行处理的。
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
这是一个难以破解的坚果，没有看到样品体被推入功能，但也许这将导致你解决。
答案 1 :(得分：0)
无效的过程调用或参数（错误5）可能意味着例如参数超出允许值的范围。
“我想协助调试这个”
要查找错误，您可以将导致错误的行拆分为单独的调用，并查看导致错误的函数。然后观察导致错误的调用中使用的参数。
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
您可以做的是在调用函数之前验证参数。例如，对于Mid函数：
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)