Question

对于这些事情，我有点新手，如果这是一个愚蠢的问题，请道歉。

我需要从一块VBA运行SQL查询。查询有点奇怪，因为它的函数中包含一个VBA变量。否则一切都很直接。 VBA应该调用查询，然后将其插入到客户端Excel文档中。

每次我在Access中运行查询一切都很好，该函数返回正确的值并过滤列。每次我在Excel中从VBA运行它时都会显示"Run-Time Error "3085"：表达式中未定义的函数'CutOff'。

我一直在寻找信息并且发现旧网站说Access 2003有时会出现这样的问题，但我正在运行2010（我认为）。只是希望问题可以解决，并非常感谢任何建议。

查询如下：

 SELECT [<TableName>].ID...*
    FROM [<TableName>]
    WHERE ((([<TableName>].ID)>CutOff()))
    ORDER BY [<TableName>]].ID;

Public Function Cutoff()
    Dim WB1 As Excel.Workbook, WS1 As Excel.Worksheet
    Dim y As Long
    Set WB1 = Workbooks.Open("C:\filepath.z.xlsm")
    Set WS1 = WB1.Sheets("Sheet2")
    y = WS1.Range("A1").End(xlDown).Offset(0, 0).Value
    'Debug.Print y
    Cutoff = y
    'Debug.Print Cutoff
End Function

运行它的VBA是从Excel运行的。我尝试过以下方法：

Sub Export2()

    Dim db2 As Database
    Dim rs2 As DAO.Recordset, i As Long, sFormat As String
    Dim WB2 As Excel.Workbook, WS2 As Excel.Worksheet
    Set WB2 = Workbooks.Open("C:\FilePath.z.xlsm")
    Set WS2 = WB.Sheets("Sheet2")
    Set db2 = OpenDatabase("C:\FilePath.x.mdb")
    Set qd2 = db2.QueryDefs("ExportCount")
    Set rs2 = qd2.OpenRecordset()

        If rs2.EOF Then
            GoTo EndLoop
        End If

    WS2.Range("a1").End(xlsDown).Offset(1, 0).CopyFromRecordset rs2
    WS2.Cells.EntireColumn.AutoFit: WS2.Cells.EntireRow.AutoFit
EndLoop:


    Set WB = Nothing
    Set WS2 = Nothing
    Set db2 = Nothing
    Set qd2 = Nothing
    Set rs2 = Nothing

End Sub

修改

还尝试过：

Sub SQLquery1()

    Dim WB1 As Excel.Workbook, WS1 As Excel.Worksheet
    Dim wt As DAO.Database
    Dim we As DAO.Recordset
    Dim wd As DAO.QueryDef

    Set WB1 = Workbooks.Open("C:\x.xlsm")
    Set WS1 = WB1.Sheets("Sheet2")
    mySQLVariable = WS1.Range("A1").End(xlDown).Offset(0, 0).Value
    'Debug.Print mySQLVariable
    Set wt = OpenDatabase("C:\z.mdb")
    Set wd = wt.QueryDefs("ExportCount")
    Set we = wd.OpenRecordset("h")

    WS2.Range("a1").End(xlsDown).Offset(1, 0).CopyFromRecordset wd
    WS2.Cells.EntireColumn.AutoFit: WS2.Cells.EntireRow.AutoFit

    Set WB1 = Nothing
    Set WS1 = Nothing
    Set wt = Nothing
    Set we = Nothing
    Set wd = Nothing

End Sub

EDIT2

Sub CreateQueryDef()
    Dim WB1 As Excel.Workbook, WS1 As Excel.Worksheet
    Dim dbPP As Database
    Dim qdfTemp As QueryDef
    Dim Counter As DAO.Recordset
    Dim mySQLVariable As String
    Dim rs5 As DAO.Recordset


    Set dbPP = OpenDatabase("C:\filepath\z.mdb")
    Set Counter = dbPP.OpenRecordset("j")
    Set WB1 = Workbooks.Open("C:\filepath\x.xlsm")
    Set WS1 = WB1.Sheets("Sheet2")
    mySQLVariable = WS1.Range("A1").End(xlDown).Offset(0, 0).Value
    'Debug.Print mySQLVariable

    With dbPP
        Set qdfTemp = dbPP.CreateQueryDef("NewQueryDef", "SELECT * FROM [j]")
        'WHERE ((j.[ID])=>(mySQLVariable)))") I can't get the syntax of these lines right - they are supposed to all be on the same line
        Set rs5 = qdfTemp.OpenRecordset() ' maybe Set rs5 = qdfTemp.OpenRecordset("NewQueryDef")?
    End With

        WS1.Range("a1").End(xlsDown).Offset(1, 0).CopyFromRecordset rs5
        WS1.Cells.EntireColumn.AutoFit: WS2.Cells.EntireRow.AutoFit
        dbPP.QueryDefs.Delete "NewQueryDef"

End Sub

或者

    Sub CreateQueryDef()
            Dim dbPP As Database
            Dim qdfTemp As QueryDef
            Dim Counter As DAO.Recordset
            Dim mySQLVariable As String
            Dim rs5 As DAO.Recordset


            Set dbPP = OpenDatabase("C:\filepath\z.mdb")
            Set Counter = dbPP.OpenRecordset("j")
            mySQLVariable = CutOff
            'Debug.Print mySQLVariable

            With dbPP
                Set qdfTemp = dbPP.CreateQueryDef("NewQueryDef", "SELECT * FROM [j] WHERE ((j.[ID])=>(mySQLVariable)))")
                Set rs5 = qdfTemp.OpenRecordset("NewQueryDef")
            End With

            WS1.Range("A1").End(xlsDown).Offset(1, 0).CopyFromRecordset rs5
            WS1.Cells.EntireColumn.AutoFit: WS2.Cells.EntireRow.AutoFit
            dbPP.QueryDefs.Delete "NewQueryDef"

            dbPP.Close

            Set dbPP = Nothing
            Set qdfTemp = Nothing
            Set Counter = Nothing
            Set mySQLVariable = Nothing
            Set rs5 = Nothing
End Sub

Public Function Cutoff()
        Dim WB1 As Excel.Workbook, WS1 As Excel.Worksheet
        Dim y As Long
        Set WB1 = Workbooks.Open("C:\filepath.z.xlsm")
        Set WS1 = WB1.Sheets("Sheet2")
        y = WS1.Range("A1").End(xlDown).Offset(0, 0).Value
        'Debug.Print y
        Cutoff = y
        'Debug.Print Cutoff
End Function

Answer 1

弄清楚我做错了什么。

需要将变量的当前值插入到用VBA编写的SQL字符串中，并将其作为临时查询传递给Access。变量的值由传递给Access的时间来确定，因此Access不需要运行宏来检索它，这需要在启用宏的情况下打开数据库，例如：

    Public y As String

    Sub definey()
      y = (VariableInput)
    Call Query
    End Sub

    Sub Query
    Dim q As DAO.Database
    Dim s As DAO.Recordset
    Dim mySQLVariable As String
    Dim strSQL As String

    mySQLVariable = y

        strSQL = "SELECT * FROM [Table1] WHERE (((Table1.ID)>" & "Chr$36 MySQLVariable Chr$36")) 
    'I'm free writing, not copying from code, so apologies if this isn't quite right

        Set q = OpenDatabase("Filepath\h.mdb")
        Set s = q.OpenRecordset(strSQL)

    '... then copy to workbook.
End Sub

从Excel调用带有VBA变量函数的SQL查询

1 个答案: