ファイルを選択して名前とパスを取得しますが、別の名前で保存します。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関数は、私が保持したい部分をキャプチャします。