With Block Not Set Error

LadyDi

Registered User.
Local time
Today, 08:59
Joined
Mar 29, 2007
Messages
894
I have the below code that seemed to work until I tried to add the Loop to it. Now, every time it gets to the piece of the loop with the words Cells.Find, I get an error stating "With Block or Variable not set". I don't understand what the problem is. There is no "With Block" and the variable is set. How can I get this to work?

Code:
Function ClearColumns(xlWS As Object, ColumnRangeToClear As String)
        xlWS.Range(ColumnRangeToClear).ClearContents
End Function
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, Col As Integer, strFilePath As String, FirstCellStr As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strFilePath is the name and path of the file you want to send this data into.
' ColumnRangeToClear is a range of columns you want to clear first.  An example is
 
'ClearColumns xlWSh, "A:G"
' or for disconnected columns
'ClearColumns xlWSh, "B:B,D:D,G:G"
 
 
 
    Dim rst    As DAO.Recordset
    Dim ApXL   As Object
    Dim xlWBk  As Object
    Dim xlWSh  As Object
    Dim fld    As DAO.Field
    Dim strPath As String
    Dim BinName As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    
    'On Error GoTo err_handler
 
 
    strPath = strFilePath

    Set rst = CurrentDb.OpenRecordset(strTQName)
 
    Set ApXL = CreateObject("Excel.Application")
 
 
    Set xlWBk = ApXL.Workbooks.Open(strPath)
 
    ApXL.Visible = True
 
    Set xlWSh = xlWBk.Worksheets(strSheetName)
    xlWSh.Select
 
     
     
    Do Until rst.EOF = True
    BinName = rst.Fields("BIN")
    Cells.Find(What:=BinName, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.End(xlToLeft).Select
    ApXL.ActiveCell.Offset(0, Col).Select
    ApXL.ActiveCell = Date
    rst.MoveNext
    Loop
    
 
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
 
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    xlWSh.Range("A3").Select
 
    xlWBk.Save
    xlWBk.Close
   ' rst.Close
    
    Set rst = Nothing
 
Exit_SendTQ2XLWbSheet:
    Exit Function
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
End Function
 
Just to play a hunch, try replacing

Code:
Do Until rst.EOF = True

with

Code:
Do Until rst.EOF

Does the problem persist?
 
Di

On what line is the error occurring? BTW, any reason for removing the error catching?
 
Cells is not a part of MS-Access, you need a reference to the Excel like you do it in other places where you have:
Code:
[B][COLOR=Red]ApXL.ActiveSheet.[/COLOR][/B]Cells.Select
 
Thank you for your suggestions. I made the changes suggested and everything is working now.
 
Well, ****. I aways have the Excel reference turned on, so it didn't even OCCUR to me that that was the problem. :banghead:
 
Well, ****. I aways have the Excel reference turned on, so it didn't even OCCUR to me that that was the problem. :banghead:
It has nothing to do with if you've the Excel reference turned on/off!
As Cells is not know by MS-Access, you need to point out where MS-Access can "find" Cells and you do that by putting the references to Excel in the front of the code line.
 
Doh, I knew that, I just totally misread your post.

That's what I get for logging in here before I've had my coffee. :-/
 

Users who are viewing this thread

Back
Top Bottom