By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,475 Members | 1,910 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,475 IT Pros & Developers. It's quick & easy.

Help! Populating Excel multiple worksheets from recordsets

P: n/a
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
Function post_export_excel()

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
'desc
wks.Range("B5:B60").ColumnWidth = 30
'inv
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("C6:D60").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
End Function
Nov 13 '05 #1
Share this question for a faster answer!
Share on Google+

This discussion thread is closed

Replies have been disabled for this discussion.