Solved

Export 5 Access Tables to 1 Excel File using VBA

Posted on 2011-09-23
7
375 Views
Last Modified: 2012-05-12
Hello,

I am using code that I found on EE and it is working so far.  However it works for 1 export to 1 file ratio.  I need to export 5 tables from one Access file to one Excel file.  Each table export would have its own tab in the Excel File.

Possible?

Sub Export_Data()
Dim rst As DAO.Recordset
Dim xlApp As Object
Dim xlWB As Object
Dim xlWs As Object
Dim xlRng As Object
Dim strTblName As String
Dim strXLFileName As String
Dim I As Long
     
    strTblName = "YAV_FORECAST"
 
    strXLFileName = "C:\VSS Excel Export\" & Month(Format(Now, "mm")) & " VSS Results"
 
    Set rst = CurrentDb.OpenRecordset(strTblName)
 
    Set xlApp = CreateObject("Excel.Application")
 
    Set xlWB = xlApp.Workbooks.Add(xlWBATWorksheet)
 
    Set xlWs = xlWB.Worksheets(1)
 
    Set xlRng = xlWs.Range("A1")
     
    For I = 0 To rst.Fields.Count - 1
        xlRng.Offset(, I).Value = rst.Fields(I).Name
    Next I
     
    xlRng.Offset(1).CopyFromRecordset rst
 
    rst.Close
 
    Set rst = Nothing
 
    Set xlRng = xlWs.UsedRange
 
    With xlRng
 
        .Font.Name = "Verdana"
        .Font.Size = 8
 
        With .Borders
            .ColorIndex = xlAutomatic
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
 
        With .Rows(1)
            .Font.Bold = True
            .Interior.ColorIndex = 15
        End With
 
        .WrapText = False
 
        .EntireColumn.AutoFit
 
    End With
 
    xlWB.SaveAs strXLFileName, True
 
    xlApp.Visible = True
 
    Set xlApp = Nothing
 
End Sub

Open in new window

0
Comment
Question by:pwdells
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
7 Comments
 

Author Comment

by:pwdells
ID: 36589467
Side Note:

I don't mind setting up a loop to run this code for each table that I need to export.  I just don't know where to find the syntax to export into an existing file and to make an additional tab for exporting/importing.
0
 
LVL 2

Expert Comment

by:sanofi-aventis
ID: 36589553
This might work. A simple Next loop with a CHOOSE function. Also add these references to your project would help you a lot. I changed all the "as Object" references. You lose all the intelisense if you use "as Object"

Sub Export_Data()

Dim rst             As ADODB.Recordset
Dim xlApp           As Excel.Application
Dim xlWB            As Excel.Workbook
Dim xlWs            As Excel.Worksheet
Dim xlRng           As Excel.Range

Dim strTblName      As String
Dim strXLFileName   As String
Dim intX            As Integer
     
    strTblName = "YAV_FORECAST"
 
    strXLFileName = "C:\VSS Excel Export\" & Month(Format(Now, "mm")) & " VSS Results"
 
    For intX = 1 To 5
   
        Set rst = CurrentProject.OpenRecordset(Choose(intX, "Table1", "Table2", "Table3", "Table4", "Table5"))
 
        Set xlApp = New Excel.Application
 
        If xlApp.Workbooks.Count < intX Then
            Set xlWB = xlApp.Workbooks.Add(xlWBATWorksheet)
        Else
            Set xlWB = xlApp.Workbooks(intX)
        End If
 
        Set xlRng = xlWs.Range("A1")
     
        For I = 0 To rst.Fields.Count - 1
            xlRng.Offset(, I).Value = rst.Fields(I).Name
        Next I
     
        xlRng.Offset(1).CopyFromRecordset rst
 
        rst.Close
 
        Set rst = Nothing
 
        Set xlRng = xlWs.UsedRange
 
        With xlRng
 
            .Font.Name = "Verdana"
            .Font.Size = 8
 
            With .Borders
                .ColorIndex = xlAutomatic
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
 
            With .Rows(1)
                .Font.Bold = True
                .Interior.ColorIndex = 15
            End With
 
            .WrapText = False
 
            .EntireColumn.AutoFit
 
        End With
       
    Next intX
 
    xlWB.SaveAs strXLFileName, True
 
    xlApp.Visible = True
 
    Set xlApp = Nothing
 
End Sub

T-Bone

Experts-Exchange.bmp
0
 

Author Comment

by:pwdells
ID: 36589735
Hi T-Bone,

I filled in the Choose() Statement as follows:

 Set rst = CurrentProject.OpenRecordset(Choose(intX, "S786", "YAV_FORECAST", "YSOC_CONSOLIDATE"))

Open in new window


I get an error:

Object doesn't support this property or method (Error 438).  The explanation is quite vague.  Have you seen this happen before with the Choose()?

Wendee
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:pwdells
ID: 36589762
P.S.  That Choose() fx is pretty nifty...if I can get it working! :0)
0
 
LVL 120

Accepted Solution

by:
Rey Obrero (Capricorn1) earned 500 total points
ID: 36589770


you can  use this format

DoCmd.TransferSpreadsheet acExport, , "table1", "c:\Myexcel.xls",true, "table1"

DoCmd.TransferSpreadsheet acExport, , "table2", "c:\Myexcel.xls",true, "table2"

DoCmd.TransferSpreadsheet acExport, , "table3", "c:\Myexcel.xls",true, "table3"

DoCmd.TransferSpreadsheet acExport, , "table4", "c:\Myexcel.xls",true, "table4"

DoCmd.TransferSpreadsheet acExport, , "table5", "c:\Myexcel.xls",true, "table5"




0
 

Assisted Solution

by:pwdells
pwdells earned 0 total points
ID: 36589874
My End Result that is working:

Private Sub Export_Data()

Dim rs_Export       As DAO.Recordset
Dim str_Export      As String
Dim db              As DAO.Database
Dim ex_ct           As Integer
Dim i               As Integer
Dim str_Table       As String
Dim str_Month       As String
Dim str_FileName    As String

Set db = CurrentDb

str_Export = _
    "SELECT tbx_Export.Table, tbx_Export.Order, tbx_Export.Active " & _
    "FROM tbx_Export " & _
    "WHERE tbx_Export.Active = -1 " & _
    "ORDER BY tbx_Export.Order "
Set rs_Export = db.OpenRecordset(str_Export)

rs_Export.MoveLast
ex_ct = rs_Export.RecordCount
rs_Export.MoveFirst

For i = 1 To ex_ct
    str_Table = rs_Export.Fields(0)
    
    str_Month = MonthName(Month(Now()), True)
    
    str_FileName = "C:\VSS Excel Export\VSS Run - " & str_Month
    
    DoCmd.TransferSpreadsheet acExport, , str_Table, str_FileName, True, str_Table
    rs_Export.MoveNext
Next i


End Sub

Open in new window

0
 

Author Closing Comment

by:pwdells
ID: 36715412
I wanted to keep this dynamic, because the names of the tables to be exported are coming from a table.  So this had to be in a loop to be able to work dynamically from a recordset.

But Cap had a real cut and dry answer.
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
AutoNumbers should increment automatically, without duplicates.  But sometimes something goes wrong, and the next AutoNumber value is a duplicate.  This article shows how to recover from this problem.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

739 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question