Save a spreadsheet with another name

[scubadiver007]

I have the following function which I can use to export data to Excel and then save and close the spreadsheet. What I would really like is to be able to re-save the spreadsheet in another location with a name taken from two queries (each with a single record).

Public Function SendToPCode(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
 
' strFilePath is the name and path of the file you want to send this data into.
 
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
 
 
    strPath = strFilePath
 
 
    Set rst = CurrentDb.OpenRecordset(strTQName)
 
    Set ApXL = CreateObject("Excel.Application")
 
 
    Set xlWBk = ApXL.Workbooks.Open(strPath)
 
    ApXL.Visible = True
 
   Set xlWSh = xlWBk.Worksheets(strSheetName)
 
   'xlWSh.Range("H5").Select
 
   ' For Each fld In rst.Fields
       ' ApXL.ActiveCell = fld.Name
       ' ApXL.ActiveCell.Offset(0, 1).Select
 '   Next
 
    rst.MoveFirst
    xlWSh.Range("C3").CopyFromRecordset rst
 
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
 
    'ApXL.Selection.Font.Bold = True
 
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
 
    ' does the "autofit" for all columns
    'ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    xlWSh.Range("E5").Select
 
    rst.Close
 
    Set rst = Nothing
    ApXL.activeWorkbook.Save
 
    ApXL.activeWorkbook.Close
Exit_SendTQ2XLWbSheet:
    Exit Function
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
 
End Function

 

[darbid]

I have the following function which I can use to export data to Excel and then save and close the spreadsheet. What I would really like is to be able to re-save the spreadsheet in another location with a name taken from two queries (each with a single record).

You can certainly do a "saveas" with excel and the object model, but I would like to suggest that you do this differently. You original master file should not be changed. As least I dont like that in case something goes wrong.

So I do the following.

1. get full path to excel file
2. make or get full path including NEW NAME of the file
3. use the FileCopy function inbuilt in access

Then open it like you already do.

dont forget to make sure the destination folder does not have the file already in it.

 

[scubadiver007]

How would I do this? I am not skilled in module coding.

Cheers

 

[darbid]

How would I do this? I am not skilled in module coding.

Cheers

That is not that hard and I suggest you have a go at it. Post back here with how you go and the errors you get.

strTQName must be already the full path to where your excel sheet currently is. So all I am suggesting is

FileCopy strTQName, destinationfullpath/excelname & ".xls"

 

[scubadiver007]

I have included the following code

ApXL.Application.ActiveWorkbook.SaveAs FileName:="O:\Medical\Enhanced Services\Enhanced Services 2011-2012\Reconciliation\Practice sheets\excel.xls"

which works but what I want to do is give the spreadsheet a unique name based on the results of two queries.

I have tried including the following and inserting the variables into the filename with "&" but it isn't accepting it. From what I understand it can only deal with one query definition at a time.

Dim KCode As DAO.QueryDef
Dim PName As DAO.QueryDef

Set KCode = db.QueryDefs("Qry_Reconciliation_PCode")
Set PName = db.QueryDefs("Qry_Reconciliation_PracticeName")

I have also tried explicitly stating the query strings using strSQL but I am having difficulty with that as well.

Cheers

 

[darbid]

I am not sure about the querydefs stuff but for the name

ApXL.Application.ActiveWorkbook.SaveAs FileName:="O:\Medical\Enhanced  Services\Enhanced Services 2011-2012\Reconciliation\Practice  sheets\excel.xls"

dim newExcelName as String

newExcelName = "myNewExcel.xls"
ApXL.Application.ActiveWorkbook.SaveAs FileName:="O:\Medical\Enhanced  Services\Enhanced Services 2011-2012\Reconciliation\Practice  sheets\" & newExcelName

 

[scubadiver007]

duh!

I have changed the code

ApXL.Application.ActiveWorkbook.SaveAs FileName:="O:\Medical\Enhanced Services\Enhanced Services 2011-2012\Reconciliation\Practice sheets\" & [Forms]![Form_PracticeSummary]![Practice_Code] & " - " & [Forms]![Form_PracticeSummary]![Practice_Name] & ".xls"

And now it works. Apologies for the bother.

 

[darbid]

great, make sure you done have in those names characters that are not allowed in windows.