Question

我将数据从Access导出到Excel。在下面的代码中，查询在Access中运行，并将结果导出到Excel中的模板文件。我想将文件保存为与模板不同的名称。

模板名称=服务器数据收集表格Template.xlsx
文件名=服务器数据收集表格+表格下拉列表中的部门名称。

我在使用与模板文件不同的名称和目录保存文件时遇到问题。

这是我的代码：

Private Sub cmdOK_Click()
On Error GoTo SubError

'Open file dialog to get filename and path so you don't hard code it

    Dim fd As FileDialog
    Dim fn As String
    Dim fc As Integer
    Set fd = Application.FileDialog(msoFileDialogOpen)
    fd.Title = "Select template file"
    fd.Filters.Clear
    fd.InitialFileName = "*Template.xlsx"
    fc = fd.Show
    fd.FilterIndex = 1

    If fc <> -1 Then
        MsgBox "No file opened"
        GoTo SubExit
    Else
        fn = fd.SelectedItems(1)
    End If

' Get the depatment name to tack onto the file name
    Dim strDept As String
    strDept = Me.cboDept

'===The below code came from https://www.youtube.com/watch?v=9yDmhzv7nns
    Dim xlApp As Excel.Application
    Dim xlWorkBook As Excel.Workbook
    Dim qdfServerBill As QueryDef
    Dim rsServerBill As Recordset

'Set up reference to the query to export
    Set qdfServerBill = CurrentDb.QueryDefs("qry_customer_input_file")

'Set up the parameter
    qdfServerBill.Parameters!prmBillMonth = Me.cboBillDate
    qdfServerBill.Parameters!prmDept = Me.cboDept

'Execute the query
    DoCmd.Hourglass True
    Set rsServerBill = qdfServerBill.OpenRecordset()

'Programmatically reference Excel and reference the workbook
    Set xlApp = CreateObject("Excel.Application")
    Set xlWorkBook = xlApp.Workbooks.Open(fn)

'Use paste from recordset to put in Excel sheet
    xlWorkBook.Worksheets("Customer Input").Cells(15, 2).CopyFromRecordset  rsServerBill

'Save Workbook, close, remove variables from memory
    xlWorkBook.Save
    xlWorkBook.Close

    Set xlWorkBook = Nothing
    Set xlApp = Nothing
    Set qdfServerBill = Nothing
    Set rsServerBill = Nothing

    MsgBox "Template is populated", vbOKOnly, "Process Successful"

SubExit:
On Error Resume Next
    DoCmd.Hourglass False
    Exit Sub

SubError:
    MsgBox "Error Number: " & err.Number & "- " & err.Description, vbCritical + vbOKOnly, "An error occurred"

End Sub

Answer 1

我想我已经弄明白了。

而不是：

'Save Workbook, close, remove variables from memory
xlWorkBook.Save

这样做：

'Save Workbook, close, remove variables from memory
xlWorkBook.SaveAs (Mid(fn, 1,66) & strDept), 51

fn变量捕获完整路径和文件名，Mid函数捕获我想要保留的部分。

选择文件以获取名称和路径，但以不同的名称保存Access vba

1 个答案: