Purdue2479
Registered User.
- Local time
- Today, 15:11
- Joined
- Jul 1, 2003
- Messages
- 52
I am using the below code to export query results from access into excel and format the spreadsheet. The code is causing an error after the first run. I've read the microsoft article http://support.microsoft.com/default.aspx?kbid=178510, but I am still at a loss. The code errors on the first With block. Thanks
Code:
Option Compare Database
Option Explicit
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim oApp As New Excel.Application
Sub Export_Qry()
Dim db As DAO.Database
Dim rs As DAO.Recordset
'Set db = DAO.DBEngine.Workspaces(0).OpenDatabase( _
"C:\database.mdb")
Set db = CurrentDb
Set rs = db.OpenRecordset("qryWholesaler_Summary_Final", dbOpenSnapshot)
'Start a new workbook in Excel
Set oBook = oApp.Workbooks.Open("U:\Desktop\Care_Caid_Test.xls")
Set oSheet = oBook.Worksheets(1)
'Add the field names in row 1
Dim i As Integer
Dim iNumCols As Integer
iNumCols = rs.Fields.Count
For i = 1 To iNumCols
oSheet.Cells(6, i + 1).Value = rs.Fields(i - 1).Name
Next
'Add the data starting at cell B6
oSheet.Range("B7").CopyFromRecordset rs
Call Format_Worksheets
Call Add_Totals
'Format the header row as bold and autofit the columns
With oSheet.Range("B6").Resize(1, iNumCols)
.Font.Bold = True
'.EntireColumn.AutoFit
End With
oApp.Visible = True
oApp.UserControl = True
'Close the Database and Recordset
rs.Close
Set oBook = Nothing
Set oSheet = Nothing
Set oApp = Nothing
'db.Close
End Sub
Sub Add_Totals()
Dim lastrow As Integer
Dim i As Integer
Set oSheet = oBook.Worksheets(1)
lastrow = oSheet.Cells(Rows.Count, "B").End(xlUp).Row
oSheet.Cells(lastrow + 2, 2).Select
ActiveCell.FormulaR1C1 = "Totals"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
For i = 3 To 12
Cells(lastrow + 2, i).FormulaR1C1 = "=SUM(R[-" & lastrow & "]C:R[-7]C)"
oSheet.Range("B" & lastrow + 2).Resize(1, i).Font.Bold = True
Next i
End Sub
Sub Format_Worksheets()
Dim lastrow As Integer
Set oSheet = oBook.Worksheets(1)
lastrow = oSheet.Cells(oSheet.Rows.Count, "B").End(xlUp).Row
oApp.ActiveSheet.Range("B" & lastrow + 2).Resize(1, 7).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
oSheet.Range("I" & lastrow + 2).Resize(1, 4).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
oSheet.Range("B" & lastrow + 2).Resize(1, 1).Select
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
oSheet.Range("B7").Resize(lastrow + 2 - 7, 6).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
oSheet.Range("I7").Resize(lastrow + 2 - 7, 4).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
oSheet.Range("B8").Resize(lastrow - 7, 11).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 15
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 15
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 15
End With
Range("C" & lastrow + 2).Select
Selection.NumberFormat = "#,##0"
Range("D" & lastrow + 2).Select
Selection.NumberFormat = "0%"
Range("F" & lastrow + 2).Select
Selection.NumberFormat = "0%"
Range("H" & lastrow + 2).Select
Selection.NumberFormat = "0%"
Range("J" & lastrow + 2).Select
Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Range("L" & lastrow + 2).Select
Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Range("A7").Select
Selection.AutoFill Destination:=Range("A7:A" & lastrow & ""), Type:=xlFillSeries
End Sub