Page 1 of 2 12 LastLast
Results 1 to 15 of 21
  1. #1
    b.grove is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2014
    Posts
    10

    Export results of one query to many excel workbooks and save to folders

    HI, I'm pretty new at programming Access. I have a query that has 1.5 million rows. I need to export 4,000 of those rows to excel and save just that 4,000 in its own workbook that increments by 1 in the name of the workbook. This export needs to perform this way until all 1.5 million are exported to a workbook.

    Here is the code I have pieced together researching on the internet. I'm getting a compile error: Object Required on the colored line and I'm not sure how to code the saving of each workbook with a file name that increments by one. ie. export_1.xlsx, export_2.xlsx. I have to do this because I will have 398 workbooks to track. the reason I have to save the query results like this is because we are uploading this to a portal that only allows 4,000 rows at a time.

    Here is my code. Any help would be WONDERFUL!!

    Sub Export2Excel()

    Dim x1APP As Excel.Application
    Dim x1WB As Excel.Workbooks
    Dim x1WS As Integer
    'Dim filename As String
    'filename = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name))) & "Import_1" & "-" & Format(Date, "yyyymmdd") & ".xlsx"
    Dim acRng As Variant
    Dim xlRow As Integer

    Dim qry As QueryDef
    Dim rst As Recordset


    Set x1APP = CreateObject("Excel.Application")
    Set xlWB = Workbooks.Open("K:\Sea\Accounts Receivable\Pinterest\Sales Report Template_upld files\2013 Oct\Export_1.xlsx")
    Set x1WS = ActiveSheet.Range("A1")

    xlRow = (x1WS.Columns("A").End(xlDown).Row)

    Set qry = CurrentDb.QueryDefs("Pinterest_Query")
    Set rst = qry.OpenRecordset

    Dim c As Integer


    c = 1
    xlRow = xlRow + 1

    Do Until rst.EOF
    For Each acRng In rst.Fields
    x1WS.Cells(xlRow, c).Formula = acRng
    c = c + 1
    Next acRng
    xlRow = xlRow + 1
    c = 1

    rst.MoveNext
    If xlRow > 10 Then GoTo rq_Exit

    Loop


    rq_Exit:
    rst.Close
    Set rst = Nothing
    Set x1WS = Nothing
    xlWB.Close acSaveYes
    Set x1WB = Nothing
    x1APP.Quit

  2. #2
    ItsMe's Avatar
    ItsMe is offline Sometimes Helpful
    Windows 7 64bit Access 2010 32bit
    Join Date
    Aug 2013
    Posts
    7,862
    Dim x1WS As Integer

    .ActiveSheet probably does not fit into an integer

    Post 9 and 10 have some examples.
    https://www.accessforums.net/program...tml#post210391


    Post #9 uses early binding which is generally recognized as the preferred method. Post #10 uses late binding. Late binding will use something like

    Dim x1WS As Object

    Where early bind, that requires reference to the library, will look something like this


    Dim x1WS As Excel.Worksheet


    EDIT: I was looking at your code and you might be able to get something like this to work

    Set x1WS = xlWB.ActiveSheet.Range("A1")

  3. #3
    b.grove is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2014
    Posts
    10
    Thank you so much for your help in debugging this. Of course I have a deadline so the help is greatly appreciated.

    I changed the code for Set x1WS = xlWB.ActiveSheet.Range("A1")
    and I'm getting this error

    Compile Error: Method or data member not found

  4. #4
    ItsMe's Avatar
    ItsMe is offline Sometimes Helpful
    Windows 7 64bit Access 2010 32bit
    Join Date
    Aug 2013
    Posts
    7,862
    It was just a shot in the dark.

    I say go with the examples in the link.

    So change
    Dim x1WS As Integer

    to
    Dim x1WS As Excel.Worksheet

    then change
    Set x1WS = ActiveSheet.Range("A1")

    to
    Set xlWs = xl.ActiveWorksheet

    You might get another error farther down now but, I don't have the time this minute to test it. Give it a try and see what you get. I do not quite understand what you are going for. In other words, Access will go after A1 by default. So I don't know why you are bothering with ranges. In the end, .CopyFromRecordset may be a better approach.

  5. #5
    b.grove is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2014
    Posts
    10
    Well I'm getting a runtime error 424bject required on the Set xlWS = xlWS.ActiveWorksheet

    Dim x1APP As Excel.Application
    Dim x1WB As Excel.Workbooks
    Dim x1WS As Excel.Worksheet
    Dim rst As DAO.Recordset
    Dim acRng As Variant
    Dim xlRow As Integer

    Set x1APP = CreateObject("Excel.Application")
    Set xlWB = xlWB.ActiveWorkbooks
    Set xlWS = xlWS.ActiveWorksheet
    Set rst = CurrentDb.OpenRecordset("Pinterest_Query")

    DoCmd.TransferSpreadsheet 1, acSpreadsheetTypeExcel12Xml, "Pinterest_Query", ("K:\Sea\Accounts Receivable\Pinterest\Sales Report Template_upld files\2013 Oct\PinterestExport_1.xlsx"), True


    Dim c As Integer
    c = 1
    xlRow = xlRow + 1

    Do Until rst.EOF
    For Each acRng In rst.Fields
    x1WS.Cells(xlRow, c).Formula = acRng
    c = c + 1
    Next acRng
    xlRow = xlRow + 1
    c = 1

    rst.MoveNext
    If xlRow > 10 Then GoTo rq_Exit

    Loop

  6. #6
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,815
    You Dim x1WB but Set xlWB.
    You Dim x1WS but Set xlWS.

    Set xlWB = x1APP.ActiveWorkbooks
    Set xlWS = xlWB.ActiveWorksheet

    Do you have Option Explicit in the module header? Every module should have this line which will mandate declaration of variables. Then Debug > Compile will help reveal typo errors like these.
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  7. #7
    ItsMe's Avatar
    ItsMe is offline Sometimes Helpful
    Windows 7 64bit Access 2010 32bit
    Join Date
    Aug 2013
    Posts
    7,862
    You have
    Code:
    Set x1APP = CreateObject("Excel.Application")
    Set xlWB = xlWB.ActiveWorkbooks
    Set xlWS = xlWS.ActiveWorksheet
    And it should be more like
    Code:
    Set x1APP = CreateObject("Excel.Application")
    Set xlWB = x1APP.ActiveWorkbooks
    Set xlWS = x1APP.ActiveWorksheet 'I think active worksheet goes under the application object but it might work for the workbook too; like June shows

  8. #8
    b.grove is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2014
    Posts
    10
    Thank you both for helping me. Since I'm having such a problem with Object Errors I rethought my code and came up with this. The NEW problem is having results from the Query to start under the A1 Column heading. The query results are over writing on my headings. UGH!!! Any suggestions??

    Option Explicit
    Sub Export2Excel()


    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim fileName As Object

    Dim acRng As Variant
    Dim xlRow As Integer
    Dim i As Integer

    'Identify the database and query
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Pinterest_Query", dbOpenDynaset)

    'Clear previous contents
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    With xlApp
    .Visible = True
    .Workbooks.Add
    .Sheets("Sheet1").Select


    'Add column headings
    For i = 1 To rs.Fields.Count
    xlApp.ActiveSheet.Cells(1, i).Value = rs.Fields(i - 1).Name
    Next i
    xlApp.Cells.EntireColumn.AutoFit

    'count number of rows to copy
    Dim c As Integer
    c = 2
    xlRow = xlRow + 1

    Do Until rs.EOF
    For Each acRng In rs.Fields
    .Cells(xlRow, c).Formula = acRng
    c = c + 2
    Next acRng
    xlRow = xlRow + 1
    c = 2
    rs.MoveNext
    If xlRow > 10 Then GoTo rq_Exit

    Loop



    'copy recordset to excel
    .ActiveSheet.Range("A2").CopyFromRecordset rs

    'save excel file

    Set fileName = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name))) & "Import_1" & "-" & Format(Date, "yyyymmdd") & ".xlsx"


    End With


    rq_Exit:
    rs.Close
    Set rs = Nothing
    xlApp.Quit



    End Sub

  9. #9
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,815
    Start on row 2?

    c = 2
    xlRow = 2
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  10. #10
    ItsMe's Avatar
    ItsMe is offline Sometimes Helpful
    Windows 7 64bit Access 2010 32bit
    Join Date
    Aug 2013
    Posts
    7,862
    That would be my guess. xlRow is never initialized so xlRow = xlRow + 1 won't work untill after it is initialized as June indicates.

  11. #11
    b.grove is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2014
    Posts
    10
    do either of you have an example where someone counted the number of rows in a recordset up to 10 rows then copied those rows over to excel and placed them under the column headings. I think that is my problem i'm trying to piece together code that never worked in the first place. so I'm fixing other peoples problems before I can get mine created.

  12. #12
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,815
    Write 10 records at a time? Why would that be needed for your situation?

    I do have code that loops through a recordset x records and repeats the loop until end of recordset. I am writing to a temp table, not Excel but same idea. Like:

    For i = 1 to Int(rs.RecordCount / 10) + 1
    For j = 1 to 10
    If not rs.EOF Then
    'do something with record
    rs.MoveNext
    End If
    Next
    Next
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  13. #13
    b.grove is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2014
    Posts
    10
    thank you June. My code needs to count 4,000 records in the recordset then copy them to the excel spreadsheet. Then go back and count the NEXT 4,000 and repeat until all 1.5 million rows are copied to excel workbooks. Yes this will mean I will have 398 workbooks. We need access to do this because we are using excel to import into our portal which only accepts 4,000 rows at a time.

    So any example you could share would be wonderful. I have worked on this all day and cannot get any combination of code to work. very frustrated!

  14. #14
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,815
    Did my example help?

    Seems writing one record at a time could take quite a while for 1.5 million records.

    I have never tried CopyFromRecordset method but maybe it will work for your situation http://krankhaft.wordpress.com/2010/...dset-to-excel/

    Maybe open a recordset filtered to 4000 records at a time by referencing a unique ID field (autonumber might serve) to specify range. Increment the range by 4000 for each iteration of the loop until the recordset opens empty.

    I have a procedure that specifies a range based on a unique ID that is an accountable sequential value (yyyyA-xxxx).
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  15. #15
    b.grove is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2014
    Posts
    10
    This is what I came up with but I'm getting and error on the activesheet.range("A1").COPYFROM RECORDSET RS, 10,18 and I don't know why.

    If rs.RecordCount <> 0 Then
    rs.MoveFirst
    Do Until rs.EOF = True
    ActiveSheet.Range("a1").CopyFromRecordset rs, 10, 18
    Loop
    Else
    MsgBox "There are no records in the recordset."
    End If

Page 1 of 2 12 LastLast
Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 1
    Last Post: 03-11-2014, 09:29 AM
  2. Replies: 5
    Last Post: 02-03-2014, 03:06 AM
  3. Replies: 12
    Last Post: 12-17-2012, 12:47 PM
  4. Replies: 1
    Last Post: 04-30-2012, 05:10 PM
  5. Export Table in Access 2007 to Multiple Workbooks in Excel 2007
    By hutchinsm in forum Import/Export Data
    Replies: 5
    Last Post: 03-01-2012, 05:23 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums