使用Excel中的VBA变量函数调用SQL查询

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 

运行它从Excel操作的VBA。我曾尝试以下：

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。变量的值由它交给访问时间固定，所以访问并不需要运行一个宏来检索，这将要求数据库与宏开启用如：

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