Export data of current record to Excel (1 Viewer)

[Robbin-R]

I have developed a form from which I would like to export the data to Excel.
Of course, this could simply be done by clicking External data > Export > Excel, but then the whole table will be exported.

What I would like is that only the data of the current record, so the record I have selected in the form, will be exported to Excel. Therefore, I have found a code, but it seems not to work.

Private Sub Export_Click()
Dim db As Database
Dim cn As ADODB.Connection
Dim strSQL As String
Dim pad As String

Set cn = New ADODB.Connection
Set db = CurrentDb()
pad = CurrentProject.path
If Right(pad, 1) <> "\" Then pad = pad & "\"

' Selecteer alles (*) naar tabel Temp
' vanuit tabel tblProductions
' waar geldt: ID is gelijk aan ID huidige record
strSQL = "SELECT * INTO Temp " & vbCrLf
strSQL = strSQL & "FROM [tblProductions] " & vbCrLf
strSQL = strSQL & "WHERE ([ID]=" & Me.[ID] & ");"

On Error Resume Next
Kill pad & "\Test.xls"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True

On Error GoTo 0
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Temp", pad & "Test.xls", True

End Sub

This code should select all data from tblProductions for which counts that ID is equal to the ID selected in the form. All selected data should then be pasted into the newly created table Temp and from there the data should be exported to the file Test.xls, which is in the same directory as the database.

However, the table Temp and the file Test.xls are indeed created, yet they are completely empty, while there should be data in it, since tblProductions does also contain data.

 

[JamesMcS]

Try changing your SQL statement to:

strSQL = "SELECT * INTO Temp FROM [tblProductions] WHERE ([ID]=" & Me.[ID] & ");"

I think you might also have to declare the fields rather than using * - so SELECT field1, field2,... FROM [tblProductions]

 

[Robbin-R]

Changing the SQL statement does not change the outcome.

I have now inserted

    strSQL = "SELECT * INTO Temp " & vbCrLf
    strSQL = strSQL & "FROM [tblProductions] " & vbCrLf
    strSQL = strSQL & "WHERE ([ID]=" & Me.[ID] & ");"
    
    [COLOR=Navy]Dim[/COLOR] tmp
    tmp = InputBox("", "", strSQL)
            
    On Error Resume Next

On clicking Export button, it returned:

I have copy pasted it into the SQL of a new query, and I have then looked at it in Datasheet view.

All fiels were created in the Datasheet view, but still everything was empty.
When explicitly using SELECT [ID],[Title],[Customer] ... it created the fields ID, Title and Customer in the Datasheet view, but still the record was empty.

So probably it goes wrong somewhere else in the code. The table seems to be created as wished for, but obviously the values are not copied and pasted in the new table?
​

 

[JamesMcS]

Have you tried delcaring what fields you want in the query rather than just using *? I think that's the problem - it makes sense that you'd have to have at least the ID field to apply criteria to....

Edit: sorry just read the rest of your post give me 2 mins and I'll have another look

 

[JamesMcS]

And there's data in tblproductions? That's strange. What happens if you remove the WHERE clause from strsql?

 

[vbaInet]

No need to create a table? Just do this:

[COLOR=Red][B]strSQL[/B][/COLOR] = "SELECT * FROM [tblProductions] WHERE ([ID]=" & Me![ID] & ");"

Then this:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, [COLOR=Red][B]strSQL[/B][/COLOR], pad & "Test.xls", True

 

[JamesMcS]

Ah so you can use an SQL string in the place of a table name with transferspreadsheet? I didn't know that!

 

[vbaInet]

Oooh.... yes!

 

[Robbin-R]

Well it now works for me. It was a beginner's mistake. The ID is not a numeric value, but is text.

Therefore the code should be:

Private Sub Export_Click()
    Dim db As Database
    Dim cn As ADODB.Connection
    Dim strSQL As String
    Dim pad As String
    
    Set cn = New ADODB.Connection
    Set db = CurrentDb()
    pad = CurrentProject.path
    If Right(pad, 1) <> "\" Then pad = pad & "\"
    
    ' Selecteer alles (*) naar tabel Temp
    ' vanuit tabel tblProductions
    ' waar geldt: ID is gelijk aan ID huidige record
    strSQL = "SELECT * INTO Temp "
    strSQL = strSQL & "FROM tblProductions "
    strSQL = strSQL & "WHERE (((tblProductions.[ID])='" & Me.[ID] & "'));"
            
    On Error Resume Next
    Kill pad & "\Test.xls"
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True
    
    On Error GoTo 0
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Temp", pad & "Test.xls", True
    
End Sub

Two quotes had to be inserted in between [ID])= and ", and in between & " and ));"
(Hope this is clear for all, with all the quotes and brackets)

Thnx for the help anyway!

 

[vbaInet]

Maybe I should reiterate my previous post, no need to create a table. That's bad coding and it will fail in a multi-user environment.

 

[JamesMcS]

I thought it might be something to do with that, strange it didn't pop up with a data type mismatch though.

So to clarify VBA - you can assign an SQL string to a variable and use that, but you can't use the SQL statement itself? (I tried with the string itself the other day and computer said no).

 

[vbaInet]

So to clarify VBA - you can assign an SQL string to a variable and use that, but you can't use the SQL statement itself? (I tried with the string itself the other day and computer said no).

Yes you can with or without the variable.

 

[JamesMcS]

Weird, I must have done it wrong - I tried "SELECT...." and as far as I remember it said something about not finding a table by that name. I'll try it again in a bit. Have a nice weekend!

 

[vbaInet]

And you James.