Question

我敢肯定有一个非常简单的方法可以解决这个问题。假设我有一个名为query_1的查询，运行此查询时，用户必须输入两个标记为q_month, q_year的值。

我正在运行一些导出此查询的代码，但我想将用户输入值作为字符串，然后可以在代码的下一行使用。怎么会这样？

（很抱歉，我对Access语法不熟悉）

请参阅下面的尝试（我首先打开查询，因为它随后将提示用户输入值）。我知道v_Month和v_year这行是不正确的，但希望它能显示我想要更清楚地做的事情。

谢谢！

Function ExportExcel()
Dim myQueryName As String, sFolderPath As String, v_Month As String, v_Year As String

myQueryName = "query_1"
sFolderPath = "C:\Folder1"



DoCmd.OpenQuery myQueryName
v_Month = [query_1].[q_month]
v_Year = [query_1].[q_year]
myExportFileNameExcel = sFolderPath & "\" & v_Month & "\Test.xlsx"
DoCmd.OutputTo acOutputQuery, myQueryName, "ExcelWorkbook(*.xlsx)", myExportFileNameExcel, False, "", , acExportQualityPrint


End Function

Answer 1

您可以使用 InputBox ：

SomeStringVariable = InputBox("Please enter value:")

要在运行查询之前设置参数，请使用DoCmd.SetParameter：

DoCmd.SetParameter method (Access)

Answer 2

您尚未提供查询的SQL，所以我编写了一个基本查询来显示如何使用参数：

PARAMETERS  q_month Long, q_year Long;
SELECT      *
FROM        Table1
WHERE       YEAR(DateField) = q_year AND MONTH(DateField) = q_month

然后您可以使用以下代码将查询数据导出到Excel：

Sub Test()

    Dim MonthNumber As Long, YearNumber As Long

    'Get the details from the user.
    MonthNumber = InputBox("Enter month number:")
    YearNumber = InputBox("Enter full year:")

    'Pass the details to the Export procedure.
    ExportToExcel MonthNumber, YearNumber

End Sub

Public Function ExportToExcel(lMonth As Long, lYear As Long)

    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset
    Dim fld As DAO.Field

    Dim oXL As Object, oWB As Object, oWS As Object

    'Open the query as a recordset.
    Set qdf = CurrentDb.QueryDefs("Query1")
    With qdf
        .Parameters("q_Month") = lMonth
        .Parameters("q_Year") = lYear
        Set rst = .OpenRecordset
    End With

    Set oXL = CreateXL 'Create an instance of Excel.
    Set oWB = oXL.WorkBooks.Add 'Create workbook.
    Set oWS = oWB.Worksheets(1) 'Reference to first sheet.

    'Copy the data over to row 2.
    oWS.Range("A2").CopyFromRecordset rst

    'Add the field headings to row 1
    For Each fld In rst.Fields
        oWS.cells(1, fld.OrdinalPosition + 1) = fld.Name
    Next fld

    'Using the passed values again.
    MsgBox "Data exported for " & Format(DateSerial(lYear, lMonth, 1), "mmmm 'yy")

    'Assumes the month folder already exists.
    'Names folders as "01_January_18" to "12_December_18"
    oWB.SaveAs "C:\Folder1\" & Format(DateSerial(lYear, lMonth, 1), "mm_mmmm_yy") & "\Test.xlsx", 51

    rst.Close
    qdf.Close

    Set rst = Nothing
    Set qdf = Nothing

End Function

Public Function CreateXL(Optional bVisible As Boolean = True) As Object

    Dim oTmpXL As Object

    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Defer error trapping in case Excel is not running. '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    Set oTmpXL = GetObject(, "Excel.Application")

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'If an error occurs then create an instance of Excel. '
    'Reinstate error handling.                            '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Err.Number <> 0 Then
        Err.Clear
        Set oTmpXL = CreateObject("Excel.Application")
    End If

    oTmpXL.Visible = bVisible
    Set CreateXL = oTmpXL

End Function

获取变量的用户输入作为字符串以在VBA访问中使用

2 个答案: