Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 337
  • Last Modified:

Export table to Excel - insert after last record on Excel wksheet

How do I tell Excel or Access to export the data from Access table to insert into an existing Excel wksht after last record.  When I am trying to use the docmd.transferdatabase the options are limited.  Is there a work around for this issue.

Thanks,

Karen
0
Karen Schaefer
Asked:
Karen Schaefer
  • 4
1 Solution
 
Patrick MatthewsCommented:
Hi Karen,

What I would do is populate either an ADO or DAO recordset with the info you need, and then do this:

Dim xlApp As Object, xlWb As Object, xlWs As Object

'insert code to populate a variable, rs, with your recordset

Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open("c:\folder\subfolder\foo.xls")
Set xlWs = xlWb.Worksheets("Name of Worksheet")

xlWs.[a65536].End(-4162).Offset(1, 0).CopyFromRecordset rs

xlWb.Save
xlWb.Close

Set xlWs = Nothing
Set xlWb = Nothing

xlApp.Quit

Set xlApp = Nothing

Regards,

Patrick
0
 
hnasrCommented:
:)
0
 
Karen SchaeferAuthor Commented:
Thanks for the code, this looks great, however, I have 1 more question.

I need to make this so it creates and new folder name and worksheet name for each month.  The locaton of the folder and wksheet will be static, however the actual name will change each month.  ie Pivot_Mar06, Pivot_Apr06)

How do I modify the above code to allow for the changing name automatically.  I was thinking about setting so variables to pass the current date, pfileName = "Pivot " &"_" & Format(date(), "MMM") &"" & Format(Date(), "YYYY").

thanks,

Karen
0
Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

 
Karen SchaeferAuthor Commented:
This is what I have so far, what am I doing wrong . it errors at the "Set RS = CurrentDb.QueryDefs(strSQL)"

I know I am missing something.  

Public Function PivotExport()
Dim xlApp As Object, xlWb As Object, xlWs As Object, nFName As String, strSQL As String
Dim RS As ADODB.Recordset

nFName = "Pivot _" & Format(Date, "MMM") & "" & Format(Date, "YY")

    strSQL = "SELECT SystemDate, Carrier, Shortcode, UniformMsg, CountOfid, uniform_messages.uniform_message AS MessageType, tblDistinictBody_Temp.Status, Tarriff" & _
            " FROM tblDistinictBody_Temp LEFT JOIN uniform_messages ON" & _
                    " tblDistinictBody_Temp.MessageType = uniform_messages.id" & _
            " GROUP BY SystemDate, Carrier, Shortcode, UniformMsg, CountOfid, uniform_messages.uniform_message," & _
            " Status, tblDistinictBody_Temp.Tarriff"
    Set RS = CurrentDb.QueryDefs(strSQL)

'insert code to populate a variable, rs, with your recordset

Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open("I:\Access Reports\MasterMessageSystem\Pivot Tables\ &""& nfname &" \ "& nfname")
Set xlWs = xlWb.Worksheets("qryDistinctMsg_Export")

xlWs.[a65536].End(-4162).Offset(1, 0).CopyFromRecordset RS

xlWb.Save
xlWb.Close

Set xlWs = Nothing
Set xlWb = Nothing

xlApp.Quit

Set xlApp = Nothing
End Function

thanks,

Karen
0
 
Karen SchaeferAuthor Commented:
I am still looking for a solution.
0
 
Karen SchaeferAuthor Commented:
Public Function PivotExport()
Dim xlApp As Object, xlWb As Object, xlWs As Object, nFName As String, nPath As String
Dim rs As ADODB.Recordset

nFName = Format(Date, "MMMM YY""\Pivot_""MMYY"".xls""")
nPath = "I:\Access Reports\MasterMessageSystem\Pivot Tables\" & nFName

Set rs = New ADODB.Recordset

rs.Open "SELECT Format(SystemDate,'Short Date'), Carrier, Shortcode, UniformMsg, CountOfid, uniform_messages.uniform_message AS MessageType," & _
                " tblDistinctBody_Temp.Status, Tarriff" & _
    " FROM tblDistinctBody_Temp LEFT JOIN uniform_messages ON" & _
                " tblDistinctBody_Temp.MessageType = uniform_messages.id" & _
                " where SystemDate = DateAdd('d',Date(), -1)" & _
    " GROUP BY SystemDate, Carrier, Shortcode, UniformMsg, CountOfid, uniform_messages.uniform_message," & _
                " Status, tblDistinctBody_Temp.Tarriff", CodeProject.Connection, _
    adOpenStatic, adLockReadOnly
With rs

    If Not .EOF Then
        Set xlApp = CreateObject("Excel.Application")
        Set xlWb = xlApp.Workbooks.Open(nPath)
        Set xlWs = xlWb.Worksheets("qryDistinctMsg_Export")

        xlWs.[a65536].End(-4162).Offset(1, 0).CopyFromRecordset rs
       
    End If
    xlWb.Save
    xlWb.Close
End With
Set xlWs = Nothing
Set xlWb = Nothing

xlApp.Quit

Set xlApp = Nothing
End Function

this is my final solution
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now