Export to Excel, if row is not null, export to next row

if you are getting parameter error,
just put again the parameter in the querydef:
Code:
Dim rst As DAO.Recordset
With CurrentDb.QueryDefs("KPICOLLECTIVE")
    'first parameter
    .Parameters(0) = [Forms]![yourForm]![start_date_textbox]
    .Parameters(1) = [Forms]![yourForm]![end_date_textbox]
    Set rst = .OpenRecordset
End With

just replace yourForm, start_date_textbox, end_date_textbox with
the propername for your form and textboxes.
 
Good point Gasman and yes, I believe it does unless the OP is using a Constant.
 
Damn! haha, just noticed the second page on the forum :D
Thank you so much guys, let me try all this.
 
I'm messing this one up BIG TIME. Also i need 2 variables (in between dates) and dont know how to spell it out.

Code:
Sub XferData2XL()
 DoCmd.SetWarnings False
Dim sFile As String
Dim xl As Excel.Application
Dim rst
Dim lngLast As Long

strSQL = "SELECT KPICOLLECTIVE.* From KPICOLLECTIVE WHERE registrationdate =" & Me.startdate & ""
sFile = "P:\dump.xlsx"
Set rst = CurrentDb.OpenRecordset(strSQL)
Set xl = CreateObject("excel.application")
With xl
    .Workbooks.Open sFile
    .Range("A1").Select
    '.Selection.End(xlDown).Select      'goto bottom of data
    lngLast = .Range("A" & rows.Count).end(xlUp).Row
    If lngLast = 65536 Then
        MsgBox "Sheet is full"
        GoTo ExitSub
    End If
    Range("A" & lngLast + 1).Select
    '.ActiveCell.Offset(1, 0).Select    'next free row
    .ActiveCell.CopyFromRecordset rst  'paste data
    .ActiveWorkbook.Save
    .Quit
End With
ExitSub:
Set xl = Nothing
Set rst = Nothing
 DoCmd.SetWarnings True
 DoCmd.Close acQuery, "KPICOLLECTIVE"
End Sub

I have no idea what i'm doing.
 
Code:
Sub XferData2XL()
 DoCmd.SetWarnings False
Dim sFile As String
Dim xl As Excel.Application
Dim rst as dao.recordset, rst1 as dao.recordset
Dim lngLast As Long

'strSQL = "SELECT KPICOLLECTIVE.* From KPICOLLECTIVE WHERE registrationdate =" & Me.startdate & ""
With CurrentDb.QueryDefs("KPICOLLECTIVE")
    'first parameter
    .Parameters(0) = [Forms]![yourForm]![start_date_textbox]
    .Parameters(1) = [Forms]![yourForm]![end_date_textbox]
    Set rst1= .OpenRecordset
    rst1.Filter="RegistrationDate=#" & Format(Me.StartDate, "mm/dd/yyyy") & "#"
    Set rst= rst1.OpenRecordset
End With

sFile = "P:\dump.xlsx"
'Set rst = CurrentDb.OpenRecordset(strSQL)

...
...
 
Hi Arnel, thanks for replying again.

Some lines are in comment?
When i remove those comma's and run it i get


Not defined
strSQL =


I'm about to give up. Been screwing around for over a week. It's getting a little rediculous.
 
ive intensionally comment those line.
the idea is open the query.
set the parameter again.
then filter registrationdate to startdate.
 
Thanks again :).

Not defined
strSQL =

Still having that issue. I have to set the path again?
 
You should not be using strSQL anymore. arnelgb provided a neater method.
Please post your whole code for this procedure.


Thanks again :).

Not defined
strSQL =

Still having that issue. I have to set the path again?
 
Understood :). Thanks Gasman.

I still get the parameter error in the below full code.
When i debug it highlights the following line:

Set rst = rst1.OpenRecordset


Code:
Sub XferData2XL()
 DoCmd.SetWarnings False
Dim sFile As String
Dim xl As Excel.Application
Dim rst As dao.Recordset, rst1 As dao.Recordset
Dim lngLast As Long
'strSQL = "SELECT KPICOLLECTIVE.* From KPICOLLECTIVE"
With CurrentDb.QueryDefs("KPICOLLECTIVE")
    'first parameter
   .Parameters(0) = [Forms]![stats_form]![startdate]
   .Parameters(1) = [Forms]![stats_form]![enddate]
    Set rst1 = .OpenRecordset
    rst1.Filter = "RegistrationDate=#" & Format(Me.startdate, "dd/mm/yyyy") & "#"
    Set rst = rst1.OpenRecordset
End With
sFile = "P:\dump.xlsx"
'Set rst = CurrentDb.OpenRecordset(strSQL)
Set xl = CreateObject("excel.application")
With xl
    .Workbooks.Open sFile
    .Range("A1").Select
    '.Selection.End(xlDown).Select      'goto bottom of data
    lngLast = .Range("A" & rows.Count).end(xlUp).Row
    If lngLast = 65536 Then
        MsgBox "Sheet is full"
        GoTo ExitSub
    End If
    Range("A" & lngLast + 1).Select
    '.ActiveCell.Offset(1, 0).Select    'next free row
    .ActiveCell.CopyFromRecordset rst  'paste data
    .ActiveWorkbook.Save
    .Quit
End With
ExitSub:
Set xl = Nothing
Set rst = Nothing
 DoCmd.SetWarnings True
 DoCmd.Close acQuery, "KPICOLLECTIVE"
End Sub
 
Last edited:
I'm not sure what the second recordset is for as you are using your dates as parameters in the query, and I am assuming that they are being compared against RegistrationDate ?

I *think* arnelgp is trying to add a filter, I am not sure that is needed.

For the time being try the code below. You do not need all the ' for commenting out the code,I put them there to make it obvious. Also you need to try and start understanding the code. Just copying and pasting will work most times, but even the experts make mistakes. I'm not saying that is the case here, just that I would be asking what the second recordset is for if it was for me. Note that rst just opens the recordset now based on your dates.

HTH

Code:
Sub XferData2XL()
 DoCmd.SetWarnings False
Dim sFile As String
Dim xl As Excel.Application
Dim rst As dao.Recordset, rst1 As dao.Recordset
Dim lngLast As Long
'strSQL = "SELECT KPICOLLECTIVE.* From KPICOLLECTIVE"
With CurrentDb.QueryDefs("KPICOLLECTIVE")
    'first parameter
   .Parameters(0) = [Forms]![stats_form]![startdate]
   .Parameters(1) = [Forms]![stats_form]![enddate]
    Set rst = .OpenRecordset
    ''''''rst1.Filter = "RegistrationDate=#" & Format(Me.startdate, "dd/mm/yyyy") & "#"
    ''''''Set rst = rst1.OpenRecordset
End With
sFile = "P:\dump.xlsx"
'Set rst = CurrentDb.OpenRecordset(strSQL)
Set xl = CreateObject("excel.application")
With xl
    .Workbooks.Open sFile
    .Range("A1").Select
    '.Selection.End(xlDown).Select      'goto bottom of data
    lngLast = .Range("A" & rows.Count).end(xlUp).Row
    If lngLast = 65536 Then
        MsgBox "Sheet is full"
        GoTo ExitSub
    End If
    Range("A" & lngLast + 1).Select
    '.ActiveCell.Offset(1, 0).Select    'next free row
    .ActiveCell.CopyFromRecordset rst  'paste data
    .ActiveWorkbook.Save
    .Quit
End With
ExitSub:
Set xl = Nothing
Set rst = Nothing
 DoCmd.SetWarnings True
 DoCmd.Close acQuery, "KPICOLLECTIVE"
End Sub
 
Wauw! That worked instantly. However, when i run it a second time, it says the file already exists. When i overwrite it, it seems to not have changed from the previous time.

But the parameter stuff is solved. AWESOME!
 
Ok little edit. It DOES seem to work when i wait for it, close the Access application and open it again and retry. Closing the form alone and reopening it doesn't work. Quiting Access does. Which is sufficient enough for me :). Not pretty, but its ok.

Again everyone, a million thanks. Really appreciate all the hard word and effort.
 
Not sure what is happening there, mine overwrites fine as it opens a file adds, and then saves the file.?, though I am using the old strSQL version, but still?

I would walk though the code with F8 and after the .quit for Excel, open the file manually and inspect.
HTH
 
Alright guys :).

Well, i implemented it, but the end user is having difficulty filling up the excel file with data from the past.

Having the same problem after 1 time use of the code (button).
When Excel is close and the application restarted, it works most of the time. Not always even.

Im getting the following error:

Method 'Rows' of object '_Global' failed

DEBUG:
lngLast = .Range("A" & rows.Count).end(xlUp).Row


ALSO: At times it asks (after complete restart) if i want to replace the file because it already exists. When i choose yes, the file didnt really change at all.

AND ALSO: When i exported and want to open te excel file. It just doest open. I click the file and nothing happens. I fist have to open ANOTHER excel file, and when i do that, the export excel file opens in the background all the sudden.

What a mess :banghead::banghead:
 
..
lngLast = .Range("A" & rows.Count).end(xlUp).Row
rows is unknown to Access, so you need the right reference to excel in front of it. Not tested it, but I think the below would do it.
Code:
lngLast = .Range("A" & [B][COLOR=Red]xl.[/COLOR][/B]rows.Count).end(xlUp).Row
 
Thanks JHB :). But didn't work. Same error.

First time it works, second time i get the error (unless i quit access and restart)
 
..
First time it works, second time i get the error (unless i quit access and restart)
Then it is (total) clear, it is missing a reference to excel somewhere, show your code or post your database.
 
I'm responsible for that line of code, though admittedly it is something I have used in my Excel workbooks each time.

Running the code again, I got the same error message. A little puzzled as I am sure I ran it a few times previously to make sure it added as it should.

I also remember someone saying something about subsequent access to an object having to be fully qualified in another thread.?

Anyway I have run this amended version several times in a row now and it works each time.
Amended code is in red

Code:
Sub XferData2XL()
Dim sFile As String
Dim xl As Excel.Application
Dim rst
Dim lngLast As Long
Dim strSQL As String
strSQL = "SELECT Table1.* From Table1 WHERE int(Table1.CreatedDate) = " & Format(Me.txtDate, strcJetDateTime)
sFile = "c:\temp\test.xls"
Set rst = CurrentDb.OpenRecordset(strSQL)
Set xl = CreateObject("excel.application")
With xl
    .Workbooks.Open sFile
    .Range("A1").Select
    '.Selection.End(xlDown).Select      'goto bottom of data
 [COLOR=Red]   lngLast = .Range("A" & .Rows.Count).End(xlUp).Row[/COLOR]
    If lngLast = 65536 Then
        MsgBox "Sheet is full"
        GoTo ExitSub
    End If
   [COLOR=Red] .Range("A" & lngLast + 1).Select[/COLOR]
    '.ActiveCell.Offset(1, 0).Select    'next free row
    .ActiveCell.CopyFromRecordset rst  'paste data

    .ActiveWorkbook.Save
    .Quit
End With

ExitSub:
Set xl = Nothing
Set rst = Nothing
End Sub
Alright guys :).

Well, i implemented it, but the end user is having difficulty filling up the excel file with data from the past.

Having the same problem after 1 time use of the code (button).
When Excel is close and the application restarted, it works most of the time. Not always even.

Im getting the following error:

Method 'Rows' of object '_Global' failed

DEBUG:
lngLast = .Range("A" & rows.Count).end(xlUp).Row


ALSO: At times it asks (after complete restart) if i want to replace the file because it already exists. When i choose yes, the file didnt really change at all.

AND ALSO: When i exported and want to open te excel file. It just doest open. I click the file and nothing happens. I fist have to open ANOTHER excel file, and when i do that, the export excel file opens in the background all the sudden.

What a mess :banghead::banghead:
 

Users who are viewing this thread

Back
Top Bottom