Results 1 to 6 of 6

Thread: [RESOLVED] Vb

  1. #1

    Thread Starter
    New Member
    Join Date
    Sep 2010
    Posts
    2

    Resolved [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:
    1. Public Function procUpdateQry_3a(sn$, rw%, bldgid$, leasid$, suitid$)
    2.     Dim rs, sqlstr$, conn As ADODB.Connection, ptbl$, tbl$, fld$, tdel%, ptbl2$, t%, tt%, nxttbl$, lsttbl$
    3.     Dim i%, ii%, endcol%
    4.     Dim sqlins1$, sqlins2$, addrec%
    5.     Dim ok%
    6.    
    7.     'ptbl is first MRI table specified on sheet
    8.     'tbl--the MRI table ref from the current col is compared to this
    9.     'nxttbl is the col ref for the column with the next unmatching table (the next table to query)
    10.     '
    11.    
    12.     Set rs = New ADODB.Recordset
    13.     rs.CursorType = adOpenStatic
    14.     rs.LockType = adLockPessimistic
    15.    
    16.     Sheets(sn).Select
    17.    
    18.     Set conn = OpenConnection()
    19.        
    20.     If sn = "Lease Info" Then
    21.         Range("E" & Trim(Str(rw))).Activate
    22.     Else
    23.         Range("D" & Trim(Str(rw))).Activate
    24.     End If
    25.     ptbl = Left(Cells(4, ActiveCell.Offset(0, i).Column).Value, InStr(1, Cells(4, ActiveCell.Offset(0, i).Column), ".") - 1)
    26. 'If leasid = "003622" Then Stop
    27.  
    28.     Debug.Print ptbl    
    29.    
    30.     If Range("BA" & Trim(Str(rw))).Value = "Del" Then
    31.         sqlstr = "DELETE FROM " & ptbl & " WHERE BLDGID='" & Trim(bldgid) & "' AND LEASID='" & Trim(leasid) & "'"
    32.         rs.Open sqlstr, conn
    33.     Else
    34.         endcol = False: addrec = False
    35.         Do While Not endcol
    36.             'At start of sheet ptbl contains first MRI Table ref
    37.             If ptbl = "SSQF" Then
    38.                 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))) & "'"
    39.             Else
    40.                 sqlstr = "SELECT * FROM " & ptbl & " WHERE BLDGID='" & Trim(bldgid) & "' AND LEASID='" & Trim(leasid) & "'"
    41.             End If
    42.             rs.Open sqlstr, conn
    43.             If rs.BOF And rs.EOF Then
    44.                 ''record count=0 therefore data for this table must be inserted...
    45.                 'sqlins1 = "INSERT INTO " & ptbl & "(BLDGID, LEASID, "
    46.                 'sqlins2 = " VALUES('" & Trim(bldgid) & "','" & Trim(leasid) & "'"
    47.                
    48.                 'create insert query
    49.            
    50.                 'find next tableref
    51.                 'set ptbl, ii
    52.            
    53.            
    54. '                Stop
    55.                 'Exit Do
    56.            
    57.                 ok = True
    58.                 If UCase(ptbl) = "CPII" Then
    59.                     If Len(Trim(Range("D" & Trim(Str(rw))))) = 0 Then
    60.                         ok = False
    61.                     End If
    62.                 End If
    63.            
    64.                 If UCase(ptbl) = "PTWI" Then
    65.                     If Len(Trim(Range("P" & Trim(Str(rw))))) = 0 Then
    66.                         ok = False
    67.                     End If
    68.                 End If
    69.            
    70.                 If ok Then
    71.                     rs.AddNew
    72.                     addrec% = True
    73.                     rs("bldgid") = bldgid
    74.                     If UCase(ptbl) <> "SSQF" Then
    75.                         rs("leasid") = leasid
    76.                         'rs("sqfttype") = Trim(Range("I" & Trim(Str(rw))))
    77.                     End If
    78.                     If UCase(ptbl) = "SSQF" Then
    79.                         rs("sqfttype") = Trim(Range("I" & Trim(Str(rw))))
    80.                     End If
    81.            
    82.                     If UCase(ptbl) = "LATERMS" Or UCase(ptbl) = "LATERMS2" Or UCase(ptbl) = "LATERMS3" Or Left(UCase(ptbl), 2) = "LA" Or UCase(ptbl) = "SSQF" Then
    83.                         rs("suitid") = suitid
    84.                     End If
    85.                    
    86.                     If UCase(ptbl) = "SSQF" Then
    87.   (I get the error here)             rs("effdate") = Range("AE" & Trim(Str(rw)))
    88.                     End If
    89.            
    90.                 Else
    91.                
    92.                     Exit Function
    93.                 End If
    94.             End If
    Last edited by Hack; Sep 1st, 2010 at 10:59 AM. Reason: Added Highlight Tags

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Vb

    is effdate a date field?
    you may need to convert the content of the cell to a suitable value or string
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  3. #3
    Addicted Member
    Join Date
    Jul 2010
    Posts
    158

    Re: Vb

    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

  4. #4
    Frenzied Member HanneSThEGreaT's Avatar
    Join Date
    Nov 2003
    Location
    Vereeniging, South Africa
    Posts
    1,492

    Re: Vb

    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
    VB.NET MVP 2008 - Present

  5. #5
    PowerPoster techgnome's Avatar
    Join Date
    May 2002
    Posts
    34,687

    Re: Vb

    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
    * I don't respond to private (PM) requests for help. It's not conducive to the general learning of others.*
    * I also don't respond to friend requests. Save a few bits and don't bother. I'll just end up rejecting anyways.*
    * How to get EFFECTIVE help: The Hitchhiker's Guide to Getting Help at VBF - Removing eels from your hovercraft *
    * How to Use Parameters * Create Disconnected ADO Recordset Clones * Set your VB6 ActiveX Compatibility * Get rid of those pesky VB Line Numbers * I swear I saved my data, where'd it run off to??? *

  6. #6

    Thread Starter
    New Member
    Join Date
    Sep 2010
    Posts
    2

    Re: Vb

    Quote Originally Posted by VeenaMG View Post
    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!

Posting Permissions

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



Click Here to Expand Forum to Full Width