Object Error

dbsupport4me · #1 (**permalink**) 04-04-09, 12:04

All,

Have the following code:

Code:

Sub Push2DB()
    Dim dbs As DAO.Database, WsP As DAO.Workspace, RsS As DAO.Recordset, N
    Dim objXL As New Excel.Application, wrkb As Excel.Workbook, xlSht As Excel.Worksheet
    Dim SQLstr, Rng_Ary
    Dim FileToOpen, oApp As Object
    Set objXL = CreateObject("Excel.Application")
    Set xlSht = Sheets("Survey Daily Time Template")
    xlSht.Select
    FileToOpen = xlSht.Cells(60, "B")
    Set oApp = CreateObject("Access.Application")
    oApp.Visible = True
    oApp.OpenCurrentDatabase FileToOpen
    Set WsP = DBEngine.Workspaces(0)
    Set dbs = CurrentDb
    SQLstr = "SELECT * FROM tblTimeSheets;"
    Set RsS = dbs.OpenRecordset(SQLstr, dbOpenDynaset)
    With RsS
        Set xlSht = Sheets("Survey Daily Time Template")
        xlSht.Select
        For N = 15 To 49
            If Not BlankLine(N) Then
                .AddNew
                For Each Tfld In .Fields
                    If Tfld.Name = "tsh_prn" Then Tfld = xlSht.Cells(4, "B")
                    If Tfld.Name = "tsh_wan" Then Tfld = xlSht.Cells(4, "G")
                    If Tfld.Name = "tsh_pob" Then Tfld = xlSht.Cells(5, "B")
                    If Tfld.Name = "tsh_suf" Then Tfld = xlSht.Cells(5, "G")
                    If Tfld.Name = "tsh_afe" Then Tfld = xlSht.Cells(6, "B")
                    If Tfld.Name = "tsh_crw" Then Tfld = xlSht.Cells(6, "G")
                    If Tfld.Name = "tsh_dat" Then Tfld = xlSht.Cells(7, "B")
                    If Tfld.Name = "tsh_pcc" Then Tfld = xlSht.Cells(7, "G")
                    If Tfld.Name = "tsh_dcc" Then Tfld = xlSht.Cells(8, "C")
                    If Tfld.Name = "tsh_tpp" Then Tfld = xlSht.Cells(8, "G")
                    If Tfld.Name = "tsh_sty" Then Tfld = xlSht.Cells(9, "C")
                    If Tfld.Name = "tsh_tst" Then Tfld = xlSht.Cells(9, "G")
                    If Tfld.Name = "tsh_fbv" Then Tfld = xlSht.Cells(10, "C")
                    If Tfld.Name = "tsh_tml" Then Tfld = xlSht.Cells(10, "G")
                    If Tfld.Name = "tsh_fps" Then Tfld = xlSht.Cells(11, "C")
                    If Tfld.Name = "tsh_tsh" Then Tfld = xlSht.Cells(11, "G")
                    If Tfld.Name = "tsh_fpe" Then Tfld = xlSht.Cells(12, "C")
                    If Tfld.Name = "tsh_wid" Then Tfld = xlSht.Cells(N, "A")
                    If Tfld.Name = "tsh_hrs" Then Tfld = xlSht.Cells(N, "G")
                    If Tfld.Name = "tsh_ttg" Then Tfld = xlSht.Cells(N, "H")
                    If Tfld.Name = "tsh_sho" Then Tfld = xlSht.Cells(N, "I")
                    If Tfld.Name = "tsh_bzz" Then Tfld = xlSht.Cells(47, "A")
                    If Tfld.Name = "tsh_fer" Then Tfld = xlSht.Cells(48, "A")
                    If Tfld.Name = "tsh_fls" Then Tfld = xlSht.Cells(49, "A")
                    If Tfld.Name = "tsh_thr" Then Tfld = xlSht.Cells(50, "G")
                    If Tfld.Name = "tsh_tft" Then Tfld = xlSht.Cells(50, "H")
                    If Tfld.Name = "tsh_tso" Then Tfld = xlSht.Cells(50, "I")
                    If Tfld.Name = "tsh_fna" Then Tfld = xlSht.Cells(52, "A")
                Next
                .Update
            End If
        Next
        .Close
    End With

End Sub
Function BlankLine(MyRow)
    Dim TF
    Set xlSht = Sheets("Survey Daily Time Template")
    xlSht.Select
    TF = True
    If xlSht.Cells(MyRow, "A") <> "" Then
        TF = False
        Exit Function
    End If
    If xlSht.Cells(MyRow, "G") <> "" Then
        TF = False
        Exit Function
    End If
    If xlSht.Cells(MyRow, "H") <> "" Then
        TF = False
        Exit Function
    End If
    If xlSht.Cells(MyRow, "I") <> "" Then
        TF = False
    End If
End Function

When I run it it get to:

Code:

                    If Tfld.Name = "tsh_pcc" Then Tfld = xlSht.Cells(7, "G")

Then I get the error:

Quote:

Run-time error '424';

Object required

This occurs just after the previous "If" statement executes as true setting the "Tfld" to the value of the cell. I'm assuming I need to jump to the "Next" statement, so what is needed here?

I do not see a "break" or "leave" in the VBA help file, and adding "next" in the previous "IF" just gives me other errors.

DBS4M

savbill · #2 (**permalink**) 04-04-09, 15:51

>I do not see a "break" or "leave" in the VBA help file

Use the "On Error GoTo" statement to jump to a another location on error

Code:

  For n = 15 To 49
    If Not fBlankLine(n) Then
        .AddNew
       ' On Error before the loop
        On Error GoTo NextTbleName
        For Each Tfld In .Fields
            If Tfld.Name = "tsh_prn" Then Tfld = xlSht.Cells(4, "B")
            If Tfld.Name = "tsh_wan" Then Tfld = xlSht.Cells(4, "G")
            If Tfld.Name = "tsh_pob" Then Tfld = xlSht.Cells(5, "B")
            '...
            If Tfld.Name = "tsh_fna" Then Tfld = xlSht.Cells(52, "A")
' Label to go to on error
NextTbleName:
        ' Reset the error to 0 now error before next iteration
        Err = 0
        
        Next
        On Error GoTo 0
        .Update
    End If
  Next

The way "Function BlankLine(MyRow)" is written it will always return FALSE. This is because you are not returning any value or condition with the funtion the way it is written. Here is an example. I modified the function to return FALSE if there's a blank in one of the columns or TRUE if all the columns have a value.

Code:

Function fBlankLine(MyRow As Integer)
    Dim arryCols() As Variant
    Dim n As Integer

    ' cols array a,g,h,i
    arryCols = Array(1, 7, 8, 9)
    
    Set xlSht = Sheets("Survey Daily Time Template")
    'xlSht.Select
    fBlankLine = True
    
    For i = 0 To UBound(arryCols)
        n = arryCols(i)
        If Not Len(xlSht.Cells(MyRow, n)) = 0 Then
          fBlankLine = False
          Exit For
        End If
    Next
End Function

The process for updating fields could be improved to reduce the errors, so you should not have to resort to using an 'On Error' statement. Consider taking the list of Field names you are checking and reading them from a worksheet. Where the name matches you can retrieve the column and row coordinates from the worksheet list. picture attached. Note in 4 of your if statements you are using the variable "N", all the others have a column number, you would need to check for these or change the process so every field worked the same.

dbsupport4me · #3 (**permalink**) 04-05-09, 09:14

Bill,

Right Idea, but "Exit For" won't work as "ALL" the cells in a row have to be checked for blanks. Must check data rows (15-49) colums A,G,H,I (A-F merged) for blanks and skip or not write to DB, but is any value in the line, must write to DB, even if not complete. Probably need another Function to test for complete line.

I kept working on it and have this code, attached, which works now. Could not paste here, exceeded input requirements.

You can see I resolved with a "GOTO" statement, but hate this type of coding. Just think it is not optimal. My BlankLine function, I think is not working right, as using "Exit Function" and really do not want to exit, until full line is tested. Not sure what I need to do here, unless another "GOTO", which I hate. Really think it is now functioning more as a "Complete Line" test than a true "Blank Line" test. Still testing that.

I still have to add is check on lines 47-49, where values are required, no test for that currently.

If you see somewhere to optimize this code, your suggestions would be appreciated.

Thanks!

OMR