Save an Excel Workbook from Code

[koolwaters]

Hi!

The code below is used to export data from an Access table to a specific cell in an Excel worksheet.

Public Sub ExpExcel()
Dim cnn As ADODB.Connection
Dim MyRecordset As New ADODB.Recordset
Dim MySQL As String
Dim MySheetPath As String
Dim Xl As Object
Dim XlBook As Object
Dim XlSheet As Object
Dim db As DAO.Database
Set cnn = CurrentProject.Connection

MyRecordset.ActiveConnection = cnn

    If Not IsNothing(Me.StartDate) Then
        If Not IsDate(Me.StartDate) Then
            MsgBox "You must enter a valid 'Beginning' date.", vbExclamation, gstrAppTitle
            Me.StartDate.SetFocus
            Exit Sub
        End If
    End If
    If Not IsNothing(Me.EndDate) Then
        If Not IsDate(Me.EndDate) Then
            MsgBox "You must enter a valid 'Ending' date.", vbExclamation, gstrAppTitle
            Me.EndDate.SetFocus
            Exit Sub
        End If

        If Not IsNothing(Me.StartDate) Then
            If Me.EndDate < Me.StartDate Then
                MsgBox "'Ending' Date must not be earlier than 'Beginning' Date.", _
                    vbExclamation, gstrAppTitle
                Me.EndDate.SetFocus
                Exit Sub
            End If
        End If
    End If


DoCmd.SetWarnings False
DoCmd.OpenQuery ("qmtblXptFundingBySegmentRawData")
MySQL = "SELECT * FROM tblXptFundingBySegmentRawData;"
MyRecordset.Open MySQL

MySheetPath = GetFEPath & "Excel Files\Payments Allocated Raw Data.xltx"

Set Xl = CreateObject("Excel.Application")
Set XlBook = GetObject(MySheetPath)

Xl.Visible = True
XlBook.Windows(1).Visible = True
XlBook.Activate = True

Set XlSheet = XlBook.Worksheets("RawData")
XlSheet.Range("RangeRawData").ClearContents
XlSheet.Range("A4").CopyFromRecordset MyRecordset

Set XlSheet = XlBook.Worksheets("Main")
XlSheet.Range("B12") = "Payments Allocated Raw Data for the period " & Format(StartDate, "dd-mmm-yyyy") & " to " & Format(EndDate, "dd-mmm-yyyy")
XlBook.SaveAs GetFEPath & "Excel Files\Payments Allocated Raw Data- " & Format(Now(), "dd-mmm-yyyy") & ".xlsx"
    
MyRecordset.Close
MyRecordset.Close
Set cnn = Nothing
Set Xl = Nothing
Set XlBook = Nothing
Set XlSheet = Nothing

DoCmd.SetWarnings True

End Sub

The code works fine with the exception of the SaveAs .

XlBook.SaveAs GetFEPath & "Excel Files\Payments Allocated Raw Data- " & Format(Now(), "dd-mmm-yyyy") & ".xlsx"

I just want to be able to save the template but the workbook opens but it is not saved with the new name.

The database is split and GetFEPath returns the path of the frontend.

Thanks for any help.

 

[boblarson]

Does this function:

GetFEPath

return it with a backslash at the end? If not you'll have to add one or else the path will not be valid.

 

[koolwaters]

Hi Bob,

It returns the correct file path.

 

[boblarson]

What happens if you add a string variable:

Dim strSaveFile As String

And use it like this:

strSaveFile = GetFEPath & "Excel Files\Payments Allocated Raw Data- " & Format(Date, "dd-mmm-yyyy") & ".xlsx"

XlBook.SaveAs strSaveFile, acFormatXLSX

 

[koolwaters]

That does not work either. I had actually tried something like that before.

Dim stSaveAsLocation As String

XlBook.SaveAs stSaveAsLocation

I have also added

XlBook.SaveAs stSaveAsLocation, acFormatXLSX

The template is opened, the records are copied to A4 onwards of the RawData sheet but the SaveAs just does not work.

 

[xenou]

Just to be clear, what does GetFEPath actually return? Also, do all the front ends use the same version of Excel?

 

[koolwaters]

?GetFEPath & "Excel Files\Payments Allocated Raw Data- " & Format(Date, "dd-mmm-yyyy") & ".xlsx"

Returns:

D:\Users\Testing TAP\Desktop\TAP Database Backups\Front End\Excel Files\Payments Allocated Raw Data- 29-Apr-2011.xlsx

All of the users are on Excel 2007.

I am on my personal machine now so the file path will be a different. However, GetFEPath returns the correct path.

I hope this helps.

 

[xenou]

----

 

[xenou]

Okay, these tries seem to be working ... I don't know why but GetObject seems picky about file types where as opening the book from the XL app you created does not. Maybe supplying a file name to getobject treats the templates slightly differently somehow - perhaps it opens it as a "template" rather than as an Excel file created from a template. I think you want to open the file with Excel after creating an Excel object ... so the last sub (Spam) is probably what you were aiming for.

[COLOR="Navy"]Sub[/COLOR] Foo()

[COLOR="Navy"]Dim[/COLOR] xlBk [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]
[COLOR="Navy"]Set[/COLOR] xlBk = GetObject("C:\Documents and Settings\Alex\Desktop\Test.xltx")
xlBk.Parent.DisplayAlerts = False
xlBk.SaveAs "C:\Documents and Settings\Alex\Desktop\Foo.xlsx", 51
xlBk.Parent.DisplayAlerts = True
xlBk.Parent.Quit

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] Bar()

[COLOR="Navy"]Dim[/COLOR] XL [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]
[COLOR="Navy"]Dim[/COLOR] xlBk [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]
[COLOR="Navy"]Set[/COLOR] XL = CreateObject("Excel.Application")
[COLOR="Navy"]Set[/COLOR] xlBk = XL.Workbooks.Open("C:\Documents and Settings\Alex\Desktop\Test.xltx")
xlBk.SaveAs "C:\Documents and Settings\Alex\Desktop\bar.xlsx"
xlBk.Close False
XL.Quit

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] Spam()

[COLOR="Navy"]Dim[/COLOR] XL [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]
[COLOR="Navy"]Dim[/COLOR] xlBk [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]
[COLOR="Navy"]Set[/COLOR] XL = GetObject(, "Excel.Application")
[COLOR="Navy"]Set[/COLOR] xlBk = XL.Workbooks.Open("C:\Documents and Settings\Alex\Desktop\Test.xltx")
xlBk.SaveAs "C:\Documents and Settings\Alex\Desktop\spam.xlsx"
xlBk.Close False
XL.Quit

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

 

[Norie]

Michelle

Is D a mapped drive to a folder on a network?