首页 > 解决方案 > 函数正在产生编译错误

问题描述

我一直在使用下面的函数,我试图在下面的函数中添加一个条件,即如果Col"1"字符串与字符串不匹配,Category那么在 Col"1" 中有名称为 的字符串,"Permanent"因此该函数将"Permanent"与条件。

但现在我在第一行收到了一个编译错误Set Result= RSToHtmlValues(Query.RS)

我不知道为什么会出现错误,任何帮助将不胜感激。

    'Return an HTMLValues object for matching record, else return Nothing
Private Function GetHtmlValues(Category As String, Permanent As String, Condition As String) As Htmlvalues

    Dim Result As Htmlvalues
    Dim TblHtmlValues As ListObject
    Dim TableAddress As String
    Dim strQuery As String
    Dim Query As WbkQuery
    
    TableAddress = ThisWorkbook.Sheets("Sheet1").ListObjects("Table4").Range.Address
    TableAddress = Replace(TableAddress, "$", "")
    
    Set Query = New WbkQuery
    'Try the first query...
    Query.ExecuteSql CategoryConditionSql(TableAddress, Category, Condition)
    
    Set Result = RSToHtmlValues(Query.RS)
    
    'If no result from first query then run the second using `Permanent`
    If Result Is Nothing Then
        Query.ExecuteSql CategoryConditionSql(TableAddress, Permanent, Condition)
        Set Result = RSToHtmlValues(Query.RS)
    End If
    
    GetHtmlValues = Result
End Function

'Construct SQL for Category/Condition query
Function CategoryConditionSql(TableAddress As String, Category As String, Condition As String)
    Dim strQuery As String
    strQuery = "SELECT * FROM [" & LISTS_SHEET_NAME & "$" & TableAddress & "]" & _
        " WHERE Category = '" & Category & "'" & _
        " AND Condition = '" & Condition & "'"
End Function

'Return HTMLvalues object from RS (or nothing if RS has no records)
Function RSToHtmlValues(RS As Object) As Htmlvalues
    Dim Result As Htmlvalues
    If Not RS.EOF Then
        Set Result = New Htmlvalues
        Result.ConditionDescription = RecordsetHelpers.FieldToString(Query.RS.Fields("Condition Description"))
        Result.Description1 = RecordsetHelpers.FieldToString(Query.RS.Fields("Description 1"))
        Result.Description2 = RecordsetHelpers.FieldToString(Query.RS.Fields("Description 2"))
    End If
    Set RSToHtmlValues = Result
End Function

标签: sqlexcelvbafunction

解决方案


由于RSToHtmlValues()函数只接受RS属性,你应该只访问这个对象,而不是Query.

只需删除Query限定符:

'...
If Not RS.EOF Then
    Set Result = New Htmlvalues
    Result.ConditionDescription = RecordsetHelpers.FieldToString(RS.Fields("Condition Description"))
    Result.Description1 = RecordsetHelpers.FieldToString(RS.Fields("Description 1"))
    Result.Description2 = RecordsetHelpers.FieldToString(RS.Fields("Description 2"))
End If
'...

更新:

正如评论中所讨论的,HtmlValues不是一个对象。尝试Set参考以及检查Nothing将产生错误。

试试下面的。我必须更改RSToHtmlValues()函数才能替换语句:

If Result Is Nothing Then

希望我没有错过任何东西。


'Return an HTMLValues object for matching record, else return Nothing
Private Function GetHtmlValues(Category As String, Permanent As String, Condition As String) As HtmlValues

    Dim Result As HtmlValues
    Dim TblHtmlValues As ListObject
    Dim TableAddress As String
    Dim strQuery As String
    Dim Query As WbkQuery
    
    TableAddress = ThisWorkbook.Sheets("Sheet1").ListObjects("Table4").Range.Address
    TableAddress = Replace(TableAddress, "$", "")
    
    Set Query = New WbkQuery
    'Try the first query...
    Query.ExecuteSql CategoryConditionSql(TableAddress, Category, Condition)
    
    'If no result from first query then run the second using `Permanent`
    If Not TryRSToHtmlValues(Query.RS, Result) Then
        Query.ExecuteSql CategoryConditionSql(TableAddress, Permanent, Condition)
        TryRSToHtmlValues Query.RS, Result
    End If
    
    GetHtmlValues = Result
End Function

'Construct SQL for Category/Condition query
Function CategoryConditionSql(TableAddress As String, Category As String, Condition As String)
    Dim strQuery As String
    strQuery = "SELECT * FROM [" & LISTS_SHEET_NAME & "$" & TableAddress & "]" & _
        " WHERE Category = '" & Category & "'" & _
        " AND Condition = '" & Condition & "'"
End Function

'Fill HTMLvalues object from RS (or nothing if RS has no records) and report success/failure
Function TryRSToHtmlValues(ByVal RS As Object, ByRef webValues As HtmlValues) As Boolean

    If RS.EOF Then Exit Function
    
    webValues.ConditionDescription = RecordsetHelpers.FieldToString(RS.Fields("Condition Description"))
    webValues.Description1 = RecordsetHelpers.FieldToString(RS.Fields("Description 1"))
    webValues.Description2 = RecordsetHelpers.FieldToString(RS.Fields("Description 2"))

    TryRSToHtmlValues = True
    
End Function


推荐阅读