B
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
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