Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Question about TransferSpreadsheet 1

Status
Not open for further replies.
irethedo

irethedo

Technical User
Feb 8, 2005
429
US
thread705-1525294

Somehow this thread got closed and not resolved, so I am opening it up again...

Good day,
I normally do not use the Transferspreadsheet function but rather CopyFromRecordset function. You can specify where you want to place the data and if needed any formating can be done from within Access. I find this method easier to use.

Below is an answer I gave someone a few months ago. Try it and see if it helps.

I use a different method to export data from Access to Excel. I copy the whole table/query to the sheet with the steps indicated below. It is an extract of the method I use for all data exported to Excel and do most of the formatting from within Access.

If need you could trasfer the data to a different work sheet and then from within Excel append it to the table in Excel or do a row count via Access in Excel and use that number to append it from there.

Remember to synchronize your query with the columns in Excel if you copy directly into and existing table.

Hope this helps.

Hennie

Set objExcel = CreateObject("Excel.Application")
'Run qryMisaRSP and transfer data to sheet RSP for annual statistics.

Set rs1 = db.OpenRecordset("tblMisaRSP", dbOpenSnapshot)

'Set the object variable to reference the file you want to see.

With objXL
.Visible = True

Set objWkb = .Workbooks.Open(conWKB_NAME)

On Error Resume Next

Set objSht = objWkb.Worksheets(conSHT_NAME1) 'RSP
objWkb.Worksheets("RSP").Activate

objWkb.Windows("RSP").Visible = True

With objSht

'Copy data from the two record sets
.Range("A2").CopyFromRecordset rs1
Click to expand...

Thanks Hennie but there seems to be a few things missing.

I added DIM statements at the top of the code below along with the End With but the code crashes
with an Object required message on the Set Rs1 line.

What other definitions are needed for this?

Thanks


Code: 
Dim rs1 As Recordset
Dim objExcel As Object

Set objExcel = CreateObject("Excel.Application")
    'Run Ord_tbl_qry and transfer data from Ord_tbl to sheet Order for Sales Order information.

    Set rs1 = db.OpenRecordset("Ord_tbl", dbOpenSnapshot)

        'Set the object variable to reference the file you want to see.

        With objXL
            .Visible = True

            Set objWkb = .Workbooks.Open(conWKB_NAME)

            On Error Resume Next

            Set objSht = objWkb.Worksheets(conSHT_NAME1)         'RSP
            objWkb.Worksheets("RSP").Activate

            objWkb.Windows("RSP").Visible = True

            With objSht

                'Copy data from the two record sets
                .Range("A2").CopyFromRecordset rs1
            End With
        End With
 
Sort by date Sort by votes
Thanks SamIAm

Transferring multiple tables/queries from Access to a single Excel workbook is something we do all the time. Here is a sample of the code to transfer 4 tables from Access to a single xls book called 'FileName'.

Dim SheetName1 As String
Dim SheetName2 As String
Dim SheetName3 As String
Dim Sheetname4 As String

SheetName1 = "tblOne"
SheetName2 = " tblTwo "
SheetName3 = " tblThree "
Sheetname4 = " tblFour "

DoCmd.TransferSpreadsheet acExport, 8, SheetName1, FileName, False, ""

DoCmd.TransferSpreadsheet acExport, 8, SheetName2, FileName, False, ""

DoCmd.TransferSpreadsheet acExport, 8, SheetName3, FileName, False, ""

DoCmd.TransferSpreadsheet acExport, 8, Sheetname4, FileName, False, ""

We then format each sheet in xls using Access VBA code.
Click to expand...

I have tried the DoCmd.TransferSpreadsheet acExport function but my experience with this
command is that it will only export to Column 1 Row 1 and because I am attempting to append
to an existing spreadsheet it creates a new worksheet (tab in my spreadsheet).

 
Upvote 0 Downvote
You should always set "Option Explicit" in your general declarations and then make sure your code compiles. You have different spellings of the same object and you haven't dim'd:
[ul]
[li]db[/li]
[li]objXL[/li]
[li]objWkb[/li]
[li]objSht[/li]
[/ul]
You should be explicit with
Code: 
Dim db as DAO.Database
Dim rs1 As DAO.Recordset

I trust your constants are declared somewhere and have values.

Duane
Hook'D on Access
MS Access MVP
 
Upvote 0 Downvote
This works for me after I added some declarations and pull the constants from procedure arguments.


Code: 
Option Compare Database
Option Explicit
Public Sub CreateExcel(conWKB_NAME As String, conSht_NAME1 As String)
    
    Dim db As DAO.Database
    Dim rs1 As DAO.Recordset
    
    Dim objXL As Object
    Dim objWkb As Object
    Dim objSht As Object
    Set objXL = CreateObject("Excel.Application")
    [COLOR=#4E9A06]'Run Ord_tbl_qry and transfer data from Ord_tbl to sheet Order for Sales Order information.[/color]
    Set db = CurrentDb
    Set rs1 = db.OpenRecordset("OneTable", dbOpenSnapshot)
    
    [COLOR=#4E9A06]'Set the object variable to reference the file you want to see.
[/color]    
    With objXL
        .Visible = True
        
        Set objWkb = .Workbooks.Open(conWKB_NAME)
        
        On Error Resume Next
        
        Set objSht = objWkb.Worksheets(conSht_NAME1)         'RSP
        objWkb.Worksheets("RSP").Activate
        
        objWkb.Windows("RSP").Visible = True
        
        With objSht
        
            [COLOR=#4E9A06]'Copy data from the two record sets[/color]
            .Range("A2").CopyFromRecordset rs1
        End With
    End With
End Sub

Duane
Hook'D on Access
MS Access MVP
 
Upvote 0 Downvote
Thanks Duane-

This works pretty good and places the table data into the correct worksheet but it over-writes existing records.

How difficult would it be to find the last row used and append to the next row on the spreadsheet?

 
Upvote 0 Downvote
I think last row can be found with this code.

Code: 
Dim lngLastRow as Long
lngLastRow = objSht.Cells.Find(What:="*", _
                            After:=objSht.Range("A1"), _
                            LookAt:= 2, _
                            LookIn:= -4123, _
                            SearchOrder:= 1, _
                            SearchDirection:= 2, _
                            MatchCase:=False).Row

Duane
Hook'D on Access
MS Access MVP
 
Upvote 0 Downvote
Thanks again Duane-

I inserted this into the code and modified the .Range("A2") to the point to the next row

Works great.

thanks again for your help Duane!


Code: 
    With objXL
        .Visible = True
        
        Set objWkb = .Workbooks.Open("C:\Order_Stuff.xlsx")
        
        On Error Resume Next
        
        Set objSht = objWkb.Worksheets("NewOrders")         'RSP
        objWkb.Worksheets("RSP").Activate
        
        objWkb.Windows("RSP").Visible = True

[b]        lngLastRow = objSht.Cells.Find(What:="*", _
                            After:=objSht.Range("A1"), _
                            LookAt:=2, _
                            LookIn:=-4123, _
                            SearchOrder:=1, _
                            SearchDirection:=2, _
                            MatchCase:=False).Row
        With objSht[/b]
        
            'Copy data from the two record sets
  '          .Range("A2").CopyFromRecordset rs1
            [b].Range[u]("A" & lngLastRow + 1[/u]).CopyFromRecordset rs1[/b]
        End With
    End With
 
Upvote 0 Downvote
Well Duane, I tried to give you a star for each of the two great posts that made on this thread but apparently
only one can be displayed per thread unless I am not doing it right.

There is one strange thing that I noticed and that is the spreadsheet is opened by this code (and left open)
and when I close the Spreadsheet from the Excel application, there seems to be some residual blank ghost excel
workbook that is open which I have to also close manually from the Excel application.

Have you seen this anomaly before?

Thanks

 
Upvote 0 Downvote
I tried both of these in order to close the excel spreadsheet after it was updated but neither of these worked.

objWkb.Workbooks("C:\Order_Stuff.xlsx").Close SaveChanges:=True

objWkb.Workbooks.Close SaveChanges:=True
 
Upvote 0 Downvote
Thanks Duane-

set objXL = Nothing

does not close the excel spreadsheet either
I also tried both of these individually on either side of the
set objXL = Nothing and still doesn't work...'
objWkb.Workbooks("C:\Order_Stuff.xlsx").Close SaveChanges:=True

objWkb.Workbooks.Close SaveChanges:=True
 
Upvote 0 Downvote
Setting excel/workbook to nothing only releases variables without touching the objects. You need close objects (firstly workbook next excel application) and then set variables to Nothing:
[tt]objWkb.Workbooks("C:\Order_Stuff.xlsx").Close SaveChanges:=True
objXL.Quit
Set objXL = Nothing
Set objWkb = Nothing[/tt]

combo
 
Upvote 0 Downvote
Setting excel/workbook to nothing only releases variables without touching the objects. You need close objects (firstly workbook next excel application) and then set variables to Nothing:
objWkb.Workbooks("C:\Order_Stuff.xlsx").Close SaveChanges:=True
objXL.Quit
Set objXL = Nothing
Set objWkb = Nothing
combo
Click to expand...

Thanks Combo

I tried what you suggested and the excel spreadsheet now displays a pop-up window asking if
I want to save the changes made.

Is there a way to squelch this from happening so that the spreadsheet is saved and closed
without user involvement?

 
Upvote 0 Downvote
Thanks Duane but this doesn't work for me either...

Could it be something in the way Excel is set up on my PC?

Here is what my code looks like:

Code: 
Private Sub tektips_Click()

Dim strSql As String
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim objXL As Object
Dim objWkb As Object
Dim objSht As Object
Dim lngLastRow As Long


    Set objXL = CreateObject("Excel.Application")
    'Run Ord_tbl_qry and transfer data from Ord_tbl to sheet Order for Sales Order information.
    Set db = CurrentDb
    Set rs1 = db.OpenRecordset("Ord_tbl", dbOpenSnapshot)
    
    With objXL
        .Visible = True
        
        Set objWkb = .Workbooks.Open("C:\Order_Stuff.xlsx")
        
        On Error Resume Next
        
        Set objSht = objWkb.Worksheets("NewOrders")         'RSP
        objWkb.Worksheets("RSP").Activate
        
'        objWkb.Windows("RSP").Visible = True

        lngLastRow = objSht.Cells.Find(What:="*", _
                            After:=objSht.Range("A1"), _
                            LookAt:=2, _
                            LookIn:=-4123, _
                            SearchOrder:=1, _
                            SearchDirection:=2, _
                            MatchCase:=False).Row
        With objSht
            .Range("A" & lngLastRow + 1).CopyFromRecordset rs1
        End With
    End With

  objWkb.Workbooks("C:\Order_Stuff.xlsx").Close SaveChanges:=True

    objXL.Quit
    
    Set rs1 = Nothing
    Set objXL = Nothing
    Set objWkb = Nothing

End Sub
 
Upvote 0 Downvote
Ok,

I made a few changes and this actually now works:

Code: 
Private Sub tektips_Click()

Dim strSql As String
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim objXL As Object
Dim objWkb As Object
Dim objSht As Object
Dim lngLastRow As Long


    Set objXL = CreateObject("Excel.Application")
    'Run Ord_tbl_qry and transfer data from Ord_tbl to sheet Order for Sales Order information.
    Set db = CurrentDb
    Set rs1 = db.OpenRecordset("Ord_tbl", dbOpenSnapshot)
    
    With objXL
        .Visible = True
        
        Set objWkb = .Workbooks.Open("C:\Order_Stuff.xlsx")
        
        On Error Resume Next
        
        Set objSht = objWkb.Worksheets("NewOrders")         'RSP
        objWkb.Worksheets("RSP").Activate
        
'        objWkb.Windows("RSP").Visible = True

        lngLastRow = objSht.Cells.Find(What:="*", _
                            After:=objSht.Range("A1"), _
                            LookAt:=2, _
                            LookIn:=-4123, _
                            SearchOrder:=1, _
                            SearchDirection:=2, _
                            MatchCase:=False).Row
        With objSht
            .Range("A" & lngLastRow + 1).CopyFromRecordset rs1
        End With
    End With

    objWkb.Save
    objWkb.Close
    objXL.Quit
    With objXL
        .Visible = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With

    Set objXL = Nothing
    Set rs1 = Nothing

End Sub

Thanks everybody for your help with this...
 
Upvote 0 Downvote
You can remove
[pre]With objXL
.Visible = True
.EnableEvents = True
.DisplayAlerts = True
End With[/pre]
You apply it to non-existing object (excel is already closed: objXl.Quit) and you have no error message only due to prior [tt]On Error Resume Next[/tt].

combo
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Kennelbloke
  • Locked
  • Question
TransferSpreadsheet 3125 Error
Replies
5
Views
694
Andrzejek
Andrzejek
rdpress
  • Locked
  • Question
Question Open Shellling to File Explorer
Replies
3
Views
122
Andrzejek
Andrzejek
PCX
  • Locked
  • Question
TransferSpreadsheet method omits last row if there are headers
Replies
1
Views
134
Andrzejek
Andrzejek
RolandR
  • Locked
  • Question
Access Rich Text Memo Field Question
Replies
1
Views
121
RolandR
RolandR
MattGreer
  • Locked
  • Question
RunSavedImportExport - How to Change Path, or How to TransferSpreadsheet?
Replies
1
Views
108
lameid
lameid

Part and Inventory Search

Sponsor

Back
Top