[Help] Export Multiple Access Tables to 1 Excel File Multiple Sheets (Code Error)

[jurigcai]

good evening programming master out there.. (sorry if my english isn't good)

let's get to the point.. now, i've work to create a simple VBA, the purpose is to compile tables on access file 2003 (.mdb) to excel file 2003 (.xls), (1 sheet for 1 table)

i've try with google, the most simple method is using acExport, but this method only export 1 table to 1 excel file and 1 sheet.. so, i try to loop until count of tables so then there will be a lot of temporary output file. after that, i'll compile those temporary files into 1 excel file with VBA that putted on access module.

here is the code :

[VBA]
Public Sub exportToXLS(sourcefile As String, targetfile As String)
Dim sql_exporttable As String
Dim tablename As String
Dim mypath As String, temp_output As String
Dim nama_targetfile As String, nama_temp_output As String
Dim db_current As Database
Dim qd As QueryDef

mypath = CurrentProject.Path

'******************** export table to 1 excel file ****************

Set db_current = CurrentDb()

For i = 0 To (ListTableSelectToXLS.ListCount - 1)
tablename = ListTableSelectToXLS.ItemData(i)
temp_output = mypath & "\" & tablename & ".xls"
Set qd = db_current.QueryDefs("TempQuery")

sql_exporttable = "SELECT * FROM [" & tablename & "] IN " & "'" & sourcefile & "'"
qd.SQL = sql_exporttable

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "TempQuery", temp_output, True

qd.Close
Set qd = Nothing
Next i


db_current.Close
Set db_current = Nothing

'************** finish export **************************


'********** compile the all output result to one excel file ********
Dim MyXL As Object, SourceXLS As Object
Dim XL_File As String
Dim SheetName As String

'kill old file if exist
If Dir(targetfile) <> "" Then
Kill targetfile
End If

'Create the Excel Application Object.
fullPath = targetfile
While InStr(1, fullPath, "\")
fullPath = Right(fullPath, Len(fullPath) - InStr(1, fullPath, "\"))
Wend
nama_targetfile = fullPath


Set MyXL = CreateObject("Excel.Application")
Set SourceXLS = CreateObject("Excel.Application")

MyXL.Workbooks.Add
'Save the Excel File
MyXL.Worksheets(1).SaveAs (targetfile)
'Show the Excel sheet in Excel Window.
MyXL.Application.Visible = True

MyXL.DisplayAlerts = False
SourceXLS.DisplayAlerts = False

counttable = ListTableSelectToXLS.ListCount - 1
For i = counttable To 0 Step -1

nama_temp_output = ListTableSelectToXLS.ItemData(i) & ".xls"
SheetName = ListTableSelectToXLS.ItemData(i)
MyXL.Sheets.Add.Name = SheetName

'copy data to sheet
temp_output = mypath & "\" & SheetName & ".xls"

SourceXLS.Workbooks.Open temp_output
'SourceXLS.Application.Visible = True

SourceXLS.Workbooks(nama_temp_output).Activate

SourceXLS.Worksheets("TempQuery").Range("A1").Select
SourceXLS.Worksheets("TempQuery").Range(SourceXLS.Selection, SourceXLS.Selection.End(xlToRight)).Select
SourceXLS.Worksheets("TempQuery").Range(SourceXLS.Selection, SourceXLS.Selection.End(xlDown)).Select

SourceXLS.Selection.Copy

MyXL.Workbooks(nama_targetfile).Activate
MyXL.Worksheets(SheetName).Activate
MyXL.Worksheets(SheetName).Range("A1").Select
MyXL.ActiveSheet.Paste

SourceXLS.Quit

Next i

Set MyXL = Nothing

Set SourceXLS = Nothing

'*********** delete temporary output file ****************
For i = 0 To (ListTableSelectToXLS.ListCount - 1)
SheetName = ListTableSelectToXLS.ItemData(i)
temp_output = mypath & "\" & SheetName & ".xls"
Kill temp_output
Next i
End Sub
[/VBA]


but i've got a problem.. code above works normally if the tables is less than 255. until i have to compile 315 of tables, which is mean, 315 sheets on 1 excel file. sheet 1 to 254 are normal. it contains data. but sheet 255 to 315, are blank, with no data (add new sheet success but it has no data). i've check to the temporary source file, all normal. all contains the data.

is there any relationship between this error and "miracle" number?? 64, 128, 256, etc etc etc... (0-255 ---> 256)..

then i try to create a dummy source file, so it will be just 1 file as a source.


[VBA]
counttable = ListTableSelectToXLS.ListCount - 1
For i = counttable To 0 Step -1

nama_temp_output = ListTableSelectToXLS.ItemData(i) & ".xls"
SheetName = ListTableSelectToXLS.ItemData(i)
MyXL.Sheets.Add.Name = SheetName

'copy data to sheet
temp_output = mypath & "\" & SheetName & ".xls"

SourceXLS.Workbooks.Open "D:\DUMMY_SOURCE.xls"
'SourceXLS.Application.Visible = True

SourceXLS.Workbooks("DUMMY_SOURCE.xls").Activate

SourceXLS.Worksheets("TempQuery").Range("A1").Select
SourceXLS.Worksheets("TempQuery").Range(SourceXLS.Selection, SourceXLS.Selection.End(xlToRight)).Select
SourceXLS.Worksheets("TempQuery").Range(SourceXLS.Selection, SourceXLS.Selection.End(xlDown)).Select

SourceXLS.Selection.Copy

MyXL.Workbooks(nama_targetfile).Activate
MyXL.Worksheets(SheetName).Activate
MyXL.Worksheets(SheetName).Range("A1").Select
MyXL.ActiveSheet.Paste

SourceXLS.Quit

Next i
[/VBA]


but this is really2 strange.. with this dummy source file, everything's going normally, even when i loop 400times (400 sheets on 1 excel file)


i do really confuse with this.. how come with dummy file everything works normally but with "real" source file, it's limited until 255 sheets only and the rest is blank?

thanks before.. im really appreciate with your help.

[jurigcai]

up up up up

up up up up

up up up up

up up up up

[jurigcai]

up up up


up up up


up up up

[Imdabaum]

If you just use a macro, you can use the TransferSpreadsheet action and just use the same file name as the parameter.

That will create a seperate sheet for each table/query.

[mohanvijay]

In Excel 2003 maximum sheets for one excel file is 255