[RESOLVED] Vb

Hello Everyone,

I getting this error message when I run the buge the cod.

Run-Time error -2147217887 (80040e21)

Multiple-step OLE DB operation
Here is the code, please take at it for me.

vb Code:

Public Function procUpdateQry_3a(sn$, rw%, bldgid$, leasid$, suitid$)
    Dim rs, sqlstr$, conn As ADODB.Connection, ptbl$, tbl$, fld$, tdel%, ptbl2$, t%, tt%, nxttbl$, lsttbl$
    Dim i%, ii%, endcol%
    Dim sqlins1$, sqlins2$, addrec%
    Dim ok%
    
    'ptbl is first MRI table specified on sheet
    'tbl--the MRI table ref from the current col is compared to this
    'nxttbl is the col ref for the column with the next unmatching table (the next table to query)
    '
    
    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenStatic
    rs.LockType = adLockPessimistic
    
    Sheets(sn).Select
    
    Set conn = OpenConnection()
       
    If sn = "Lease Info" Then
        Range("E" & Trim(Str(rw))).Activate
    Else
        Range("D" & Trim(Str(rw))).Activate
    End If
    ptbl = Left(Cells(4, ActiveCell.Offset(0, i).Column).Value, InStr(1, Cells(4, ActiveCell.Offset(0, i).Column), ".") - 1)
'If leasid = "003622" Then Stop
 
    Debug.Print ptbl    
    
    If Range("BA" & Trim(Str(rw))).Value = "Del" Then
        sqlstr = "DELETE FROM " & ptbl & " WHERE BLDGID='" & Trim(bldgid) & "' AND LEASID='" & Trim(leasid) & "'"
        rs.Open sqlstr, conn
    Else
        endcol = False: addrec = False
        Do While Not endcol
            'At start of sheet ptbl contains first MRI Table ref
            If ptbl = "SSQF" Then
                sqlstr = "SELECT * FROM " & ptbl & " WHERE BLDGID='" & Trim(bldgid) & "' AND SUITID='" & Trim(suitid) & "' AND SQFTTYPE='" & Range("I" & Trim(Str(rw))) & "' AND EFFDATE='" & Range("AE" & Trim(Str(rw))) & "'"
            Else
                sqlstr = "SELECT * FROM " & ptbl & " WHERE BLDGID='" & Trim(bldgid) & "' AND LEASID='" & Trim(leasid) & "'"
            End If
            rs.Open sqlstr, conn
            If rs.BOF And rs.EOF Then
                ''record count=0 therefore data for this table must be inserted...
                'sqlins1 = "INSERT INTO " & ptbl & "(BLDGID, LEASID, "
                'sqlins2 = " VALUES('" & Trim(bldgid) & "','" & Trim(leasid) & "'"
                
                'create insert query
            
                'find next tableref
                'set ptbl, ii
            
            
'                Stop
                'Exit Do
            
                ok = True
                If UCase(ptbl) = "CPII" Then
                    If Len(Trim(Range("D" & Trim(Str(rw))))) = 0 Then
                        ok = False
                    End If
                End If
            
                If UCase(ptbl) = "PTWI" Then
                    If Len(Trim(Range("P" & Trim(Str(rw))))) = 0 Then
                        ok = False
                    End If
                End If
            
                If ok Then
                    rs.AddNew
                    addrec% = True
                    rs("bldgid") = bldgid
                    If UCase(ptbl) <> "SSQF" Then
                        rs("leasid") = leasid
                        'rs("sqfttype") = Trim(Range("I" & Trim(Str(rw))))
                    End If
                    If UCase(ptbl) = "SSQF" Then
                        rs("sqfttype") = Trim(Range("I" & Trim(Str(rw))))
                    End If
            
                    If UCase(ptbl) = "LATERMS" Or UCase(ptbl) = "LATERMS2" Or UCase(ptbl) = "LATERMS3" Or Left(UCase(ptbl), 2) = "LA" Or UCase(ptbl) = "SSQF" Then
                        rs("suitid") = suitid
                    End If
                    
                    If UCase(ptbl) = "SSQF" Then
  (I get the error here)             rs("effdate") = Range("AE" & Trim(Str(rw)))
                    End If
            
                Else
                
                    Exit Function
                End If
            End If

is effdate a date field?
you may need to convert the content of the cell to a suitable value or string

Hi,

Change that line to :

Code:

---

If Trim(Range("AE" & Trim(Str(rw)))) <> "" Then
    If IsDate(Range("AE" & Trim(Str(rw)))) Then
        rs("effdate") = CDate(Range("AE" & Trim(Str(rw))))
    End If
End If

---

Regards
Veena

a thread entitled vb is very vague :) try using proper titles so that members can find your thread much easier when the search for it ;)

and it would have helped to note what line gives the error... clearly there seems to be a number of things potentially wrong as we've all noted something different.

Lines 31/32 ... that's not the way to run an action query... Look up the ADO.Command object...

-tg

Quote:

---

Originally Posted by VeenaMG

Hi,

Change that line to :

Code:

---

If Trim(Range("AE" & Trim(Str(rw)))) <> "" Then
    If IsDate(Range("AE" & Trim(Str(rw)))) Then
        rs("effdate") = CDate(Range("AE" & Trim(Str(rw))))
    End If
End If

---

Regards
Veena

---

Thank you for your help!