with app and with sheet/range error

[knownote]

hello all,

I probably have certain formatting lines in the wrong
with statements - with app and with sheet/range. This
code simply transfers the current record to Excel.
run-time error 91:
Object variable or With block variable not set

Thanks
John

---- Code

Private Sub cmdExcelSend_Click()

'Get recordset from Client's table
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strFilter As String
Dim qDef As QueryDef
Dim strSaveFileName As String
Dim fPath As String
Dim intLastCol As Integer
Dim oApp As Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet
Const conMAX_ROWS = 20000

'Ask for SaveFileName; Save to file

oApp.Dialogs(xlDialogSaveAs).Show "C:\*.xls"

strFilter = ahtAddFilterItem("", "Excel Files (*.xls)", "*.xls")
strSaveFileName = ahtCommonFileOpenSave(OpenFile:=False, Filter:=strFilter, _
Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)

'Test if Save As... cancelled
If strSaveFileName = "" Then
Exit Sub ' GoTo Exit_cmdExcelSend_Click
End If

Set db = CurrentDb
Set oApp = GetObject(, "Excel.Application")
If err.Number <> 0 Then
Set oApp = CreateObject("Excel.Application")
'Else: Set oApp = New Excel.Application 'instantiate Excel
End If
Set rs = db.OpenRecordset("Select * FROM tblClients WHERE Subgect='" & Nz(Me![Subgect], "") & "'")

oApp.Visible = True
oApp.UserControl = True

'Indicate task complete
MsgBox "File " & strSaveFileName & " successfully saved"

'Start a new workbook in Excel
Set oBook = oApp.Workbooks.Add '.Workbooks.Open(strSaveFileName)
Set oBook = oApp.ActiveWorkbook
Set oSheet = oBook.Worksheets(1) '.Add

'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(1, i).Value = rs.Fields(i - 1).Name
Next

'Add the data starting at cell A2
oSheet.Range("A2").CopyFromRecordset rs
'oSheet.Range("A2", intLastCol).CopyFromRecordset rs

With oApp
.Visible = True
Set oBook = .Workbooks.Open(strSaveFileName)
On Error Resume Next
Set oSheet = oBook.Worksheets("Sheet1")
If Not err.Number = 0 Then
Set oSheet = oBook.Worksheets.Add
' oSheet.Name = conSHT_NAME
End If
err.Clear
On Error GoTo 0
intLastCol = oSheet.UsedRange.Columns.Count
With oSheet
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).Font.Bold = True
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With

'Format the header row as bold and autofit the columns
With oSheet.Range("a1").Resize(1, iNumCols)
.Font.Bold = True
.EntireColumn.AutoFit
' .Range(.Cells(1, 1), _
' .Cells(1, rs.Fields.Count)).Font.Bold = True
' .EntireColumn.AutoFit
' .Range(.Cells(1, 1), .Cells(conMAX_ROWS, intLastCol)).EntireColumn.AutoFit
' .Range(.Cells(1, 1), .Cells(1, rs.Fields.Count)).Font.Bold = True
' .Range(.Cells(1, 1), .Cells(1, rs.Fields.Count)).Font.Size = 12
' .Font.Bold = True
' .Font = "Arial"
' .Font.Size = 12
' .Interior.ColorIndex = 27
' .HorizontalAlignment = xlHAlignCenter
' .Activate
End With

oBook.close True
Set oSheet = Nothing
Set oBook = Nothing
oApp.Quit ' NOTE - changed sequence
Set oApp = Nothing
rs.close
db.close
Set rs = Nothing
Set db = Nothing
' Set qDef = Nothing

End Sub

 

[PHV]

And which line of code is highlighted when in debug mode ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[knownote]

Thanks PHV

Have a look at my new thread:
blank spreadsheet saved before transfer

it somewhat works, except for a blank Excel sheet being
saved, and I'm unsure how to organize certain commented
out statements within with-end with sections for
Excel application and sheet/range/cells.

I am not a programmer, I am just sorting through code I
originally combined from four different codes.

Thanks
John