Karen Schaefer
asked on
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
Thanks,
Karen
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
:)
ASKER
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
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
ASKER
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_m essage AS MessageType, tblDistinictBody_Temp.Stat us, Tarriff" & _
" FROM tblDistinictBody_Temp LEFT JOIN uniform_messages ON" & _
" tblDistinictBody_Temp.Mess ageType = uniform_messages.id" & _
" GROUP BY SystemDate, Carrier, Shortcode, UniformMsg, CountOfid, uniform_messages.uniform_m essage," & _
" Status, tblDistinictBody_Temp.Tarr iff"
Set RS = CurrentDb.QueryDefs(strSQL )
'insert code to populate a variable, rs, with your recordset
Set xlApp = CreateObject("Excel.Applic ation")
Set xlWb = xlApp.Workbooks.Open("I:\A ccess Reports\MasterMessageSyste m\Pivot Tables\ &""& nfname &" \ "& nfname")
Set xlWs = xlWb.Worksheets("qryDistin ctMsg_Expo rt")
xlWs.[a65536].End(-4162).O ffset(1, 0).CopyFromRecordset RS
xlWb.Save
xlWb.Close
Set xlWs = Nothing
Set xlWb = Nothing
xlApp.Quit
Set xlApp = Nothing
End Function
thanks,
Karen
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_m
" FROM tblDistinictBody_Temp LEFT JOIN uniform_messages ON" & _
" tblDistinictBody_Temp.Mess
" GROUP BY SystemDate, Carrier, Shortcode, UniformMsg, CountOfid, uniform_messages.uniform_m
" Status, tblDistinictBody_Temp.Tarr
Set RS = CurrentDb.QueryDefs(strSQL
'insert code to populate a variable, rs, with your recordset
Set xlApp = CreateObject("Excel.Applic
Set xlWb = xlApp.Workbooks.Open("I:\A
Set xlWs = xlWb.Worksheets("qryDistin
xlWs.[a65536].End(-4162).O
xlWb.Save
xlWb.Close
Set xlWs = Nothing
Set xlWb = Nothing
xlApp.Quit
Set xlApp = Nothing
End Function
thanks,
Karen
ASKER
I am still looking for a solution.
ASKER
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\MasterMessageSyste m\Pivot Tables\" & nFName
Set rs = New ADODB.Recordset
rs.Open "SELECT Format(SystemDate,'Short Date'), Carrier, Shortcode, UniformMsg, CountOfid, uniform_messages.uniform_m essage AS MessageType," & _
" tblDistinctBody_Temp.Statu s, Tarriff" & _
" FROM tblDistinctBody_Temp LEFT JOIN uniform_messages ON" & _
" tblDistinctBody_Temp.Messa geType = uniform_messages.id" & _
" where SystemDate = DateAdd('d',Date(), -1)" & _
" GROUP BY SystemDate, Carrier, Shortcode, UniformMsg, CountOfid, uniform_messages.uniform_m essage," & _
" Status, tblDistinctBody_Temp.Tarri ff", CodeProject.Connection, _
adOpenStatic, adLockReadOnly
With rs
If Not .EOF Then
Set xlApp = CreateObject("Excel.Applic ation")
Set xlWb = xlApp.Workbooks.Open(nPath )
Set xlWs = xlWb.Worksheets("qryDistin ctMsg_Expo rt")
xlWs.[a65536].End(-4162).O ffset(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
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\MasterMessageSyste
Set rs = New ADODB.Recordset
rs.Open "SELECT Format(SystemDate,'Short Date'), Carrier, Shortcode, UniformMsg, CountOfid, uniform_messages.uniform_m
" tblDistinctBody_Temp.Statu
" FROM tblDistinctBody_Temp LEFT JOIN uniform_messages ON" & _
" tblDistinctBody_Temp.Messa
" where SystemDate = DateAdd('d',Date(), -1)" & _
" GROUP BY SystemDate, Carrier, Shortcode, UniformMsg, CountOfid, uniform_messages.uniform_m
" Status, tblDistinctBody_Temp.Tarri
adOpenStatic, adLockReadOnly
With rs
If Not .EOF Then
Set xlApp = CreateObject("Excel.Applic
Set xlWb = xlApp.Workbooks.Open(nPath
Set xlWs = xlWb.Worksheets("qryDistin
xlWs.[a65536].End(-4162).O
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