Repost! Excel multiple worksheet populate from recordset

[B]

Using Access2000, the sample code below is what I have been modifying and
working on since the past week and I could not get it to work properly.

What I wanted to accomplish:
1) read from a recordset and export to Excel
2) Excel is populated based from an ID (may possible be one or multiple) and
renames the worksheet based from the ID
3) the code also format the fields

The sample database may be downloaded at:
http://www.geocities.com/mgtulips/sample_db.mdb

TIA!
Bob


Dim db As Database 'used to reference the current database
Dim rs As Recordset, rsID As Recordset
Dim qDef As QueryDef
Dim xlApp As Object, wkb As Object, wks As Object
Dim sCarrier As String, sMPC As String
Dim i As Integer, intSPID As Integer
Dim strSQL As String, strSQL2 As String
Dim iWorksheets As Integer, x As Integer


Set db = CurrentDb() 'initialize the database variable to this
database
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

Set rsID = db.OpenRecordset("qryID", dbOpenDynaset)
Set wkb = xlApp.Workbooks.Add

iWorksheets = DCount("*", "qryID")
Set wks = wkb.ActiveSheet

Do While Not rsID.EOF
For x = 1 To iWorksheets
'Go to Next Worksheet
Worksheets(x).Activate

strSQL2 = "SELECT rank, desc, inv_current, inv_previous, inv_variance,"
strSQL2 = strSQL2 & " ytd_current, ytd_previous, ytd_variance,"
strSQL2 = strSQL2 & " market_share_current, market_share_previous,
share_vs_ly"
strSQL2 = strSQL2 & " FROM tmp_result_all"
strSQL2 = strSQL2 & " WHERE id = '" & rsID("id").Value & "'"
Set rs = db.OpenRecordset(strSQL2, dbOpenDynaset)

'format the excel report
wks.Range("A1:A3").Font.Bold = True
wks.Range("A1:A3").Font.Size = 10
wks.Range("A1:A3").Font.Color = RGB(255, 0, 0)
wks.Range("A1:A3").HorizontalAlignment = xlLeft

wks.Range("A5:K5").Font.Bold = True
wks.Range("A5:K5").Font.Size = 10
wks.Range("A5:K5").Font.Name = "Arial"
wks.Range("A5:K5").Interior.ColorIndex = 15
wks.Range("A5:K5").WrapText = True
wks.Range("A5:K5").HorizontalAlignment = xlCenter
wks.Range("A5:A60").HorizontalAlignment = xlCenter
wks.Range("E5:E60").HorizontalAlignment = xlCenter
wks.Range("H5:K60").HorizontalAlignment = xlCenter
wks.Range("B57:K57").Font.Bold = True
wks.Rows(5).RowHeight = 35
'wks.Range("B4:B55").HorizontalAlignment = xlLeft
'wks.Range("D:E").HorizontalAlignment = xlCenter
'rank
wks.Range("A5:A60").ColumnWidth = 15
'airline
wks.Range("B5:B60").ColumnWidth = 30
'sales
wks.Range("C5:E60").ColumnWidth = 13
'ytd_current
wks.Range("F5:F60").ColumnWidth = 12
'ytd_previous, ytd_variance
wks.Range("G5:I60").ColumnWidth = 13

wks.Range("A1").Value = "Test1"
wks.Range("A2").Value = "Test2"
wks.Range("A3").Value = "Test3"
wks.Range("A5").Value = "RANK"
wks.Range("B5").Value = "DESC"
wks.Range("C5").Value = "INV CURRENT"
wks.Range("D5").Value = "INV PREVIOUS"
wks.Range("E5").Value = "INV VARIANCE"
wks.Range("F5").Value = "YTD CURRENT"
wks.Range("G5").Value = "YTD PREVIOUS"
wks.Range("H5").Value = "YTD VARIANCE"
wks.Range("I5").Value = "MARKET SHARE CURRENT"
wks.Range("J5").Value = "MARKET SHARE PREVIOUS"
wks.Range("K5").Value = "SHARE VS LY"

wks.Range("A1").NumberFormat = "mmm-yy"
wks.Range("C660").NumberFormat = "#,##0_);-#,##0"
wks.Range("E6:E60").NumberFormat = "#,##0.00%_);-#,##0.00%"
wks.Range("F6:G60").NumberFormat = "#,##0_);-#,##0"
wks.Range("E6:E60").NumberFormat = "#,##0%_);-#,##0%"
wks.Range("H6:H60").NumberFormat = "#,##0%_);-#,##0%"
wks.Range("I6:J60").NumberFormat = "#,##0.0%_);-#,##0.0%"
wks.Range("K6:K60").NumberFormat = "#,##0%_);-#,##0%"

wks.Range("A6").CopyFromRecordset rs


'insert columns
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
wks.Range("C:C").ColumnWidth = 0.5

Columns("G:G").Select
Selection.Insert Shift:=xlToRight
wks.Range("G:G").ColumnWidth = 0.5

Columns("K:K").Select
Selection.Insert Shift:=xlToRight
wks.Range("K:K").ColumnWidth = 0.5

Rows(57).EntireRow.Insert
Range("B58:N58").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone

'delete 51 & 52 number description from RANK field in Excel
wks.Range("A56:A58").Value = ""

wks.Name = rsID("id").Value
rsID.MoveNext
Next x
Loop

rs.Close
rsID.Close

Set rs = Nothing
Set rsID = Nothing
Set qDef = Nothing
Set wkb = Nothing
Set wks = Nothing
Set xlApp = Nothing
Set db = Nothing

 

[keepITcool]

B.
You never reacted to my answer on your original post.

<

Although my code may not do exactly as you intended,
I consider this bad manners: NOT react to the answer and just
repost your question.

I realize it will not do the formatting, but it should be easy:
populate t first with ADO..(using my code)
(this takes 0.1 sec)

then open it in Excel and do the formatting:
since it's a 'fresh' file you can use the usedrange.

Set xlApp = createobject("Excel.Application)
With xlApp
With .workbooks.open(sXL)
for each wks in .worksheets
call formatExport wks
next
end with
end with

Sub FormatExport(wks as excel.worksheet)
with wks
do your formatting here...
end with
end sub






keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >


B wrote in message