選擇文件以獲取名稱和路徑，但以不同名稱保存訪問vba

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函數捕獲，我想保留的部分。