Results 1 to 5 of 5

Thread: Object Error

  1. #1
    Join Date
    Feb 2004
    Location
    Irving, TX (Dallas, Fort Worth)
    Posts
    379

    Unanswered: Object Error

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

  2. #2
    Join Date
    Feb 2004
    Posts
    533
    >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.
    ~

    Bill

  3. #3
    Join Date
    Feb 2004
    Location
    Irving, TX (Dallas, Fort Worth)
    Posts
    379

    Right Idea, but won't work?

    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
    Attached Thumbnails Attached Thumbnails XLS-Form-Snap.png  
    Attached Files Attached Files
    Last edited by dbsupport4me; 04-05-09 at 10:32.

  4. #4
    Join Date
    Feb 2004
    Location
    Irving, TX (Dallas, Fort Worth)
    Posts
    379

    Minor Problems

    All,

    OK got this one done, Knock, Knock, with just two minor problems:
    1. Sometimes get an object error when the DB open and the recordset is called,
    2. Does not always close the DB at the completetion of the process.
    If you have the answer, chime in please.

    Code attached!

    Thanks!

    OMR
    Attached Files Attached Files

  5. #5
    Join Date
    Feb 2004
    Location
    Irving, TX (Dallas, Fort Worth)
    Posts
    379

    No answers

    All,

    Does anyone no how I should make this a clean exit?

    DBS4M

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •