Solved

80040e21 and 80004005 Run-time Errors

Posted on 2010-09-12
10
2,333 Views
Last Modified: 2012-05-10
We had a developer come in and write a bit of code to check one table in our database against several others. The developer used microsoft access 2010 and vb. If the records don't exist, the code adds them. I've been getting continual Run-time 80040e21 and 80004005 errors. I have MS Access 2010, MS SQL 2005, and SQL Server Business Intelligence Development Studio. I'm a novice with VB code and can't reach the developer to help us figure this out. We are running Windows 2003 SP2. All of this takes place on the same box that I'm logging into through RDS. I've read MDAC can be an issue but I'm fully updated with 2.8 sp2. Any help would be much appreciated.
Option Compare Database



Private Sub cmdGo_Click()



    Dim conn As New ADODB.Connection

    Dim rs As New ADODB.Recordset

    Dim cmd As New ADODB.Command

    Dim yearId As String

    Dim typeId As String

    Dim makeId As String

    Dim modelId As String

    Dim groupId As String

    Dim partId As String

    Dim numRequired As String

    Dim partDesc As String

    

    Set conn = CurrentProject.Connection

    

    rs.ActiveConnection = conn

    rs.Source = "SELECT * FROM dbo_Mozenda"

    rs.Open

    

    While Not rs.EOF

        If IsNull(rs("NumRequired")) Then

            numRequired = ""

        Else

            numRequired = rs("NumRequired")

        End If

        partDesc = Left(rs("PartDescription"), 50)

        yearId = getYearId(rs("Year"))

        'MsgBox "YEARID: " & yearId

        typeId = getTypeId(rs("Type"))

        'MsgBox "TYPEID: " & typeId

        modelId = getModelId(rs("Model"), rs("MakeID"), typeId, yearId)

        'MsgBox "MODELID: " & modelId

        If modelId = "0" Then modelId = newModelId(rs("MakeId"), yearId, typeId, rs("Model"))

        'MsgBox "MODELID2: " & modelId

        groupId = getGroupId(modelId, rs("Group"))

        'MsgBox "GROUPID: " & groupId

        If groupId = "0" Then groupId = newGroupId(modelId, rs("Group"), rs("ImgURL"))

        'MsgBox "GROUPID2: " & groupId

        partId = getPartId(groupId, rs("RefNumber"), cleanPart(rs("PartNumber")))

        'MsgBox "PARTID: " & partId

        If partId = "0" Then partId = newPartId(cleanPart(rs("PartNumber")), rs("RefNumber"), numRequired, partDesc, groupId)

        'MsgBox "PARTID2: " & partId

        rs.MoveNext

    Wend



    MsgBox "DONE!!!!!!!!!!"



End Sub







Private Function getYearId(inYear As String) As String

    Dim conn As New ADODB.Connection

    Dim rs As New ADODB.Recordset

    Dim rtn As String

    

    inYear = cleanSql(inYear)

    Set conn = CurrentProject.Connection

    rs.ActiveConnection = conn

    rs.Source = "SELECT YearID FROM dbo_Year WHERE Year = '" & inYear & "'"

    rs.Open

    If Not rs.EOF Then

        rtn = rs("YearID")

    Else

        rtn = "0"

    End If

    getYearId = rtn

End Function



Private Function getTypeId(inType As String) As String

    Dim rtn As String

    Select Case inType

        Case "ATV"

            rtn = "3"

        Case "MOTORCYCLES"

            rtn = "26"

    End Select

    getTypeId = rtn

End Function



Private Function getModelId(inModel As String, inMake As String, inType As String, inYear As String) As String

    Dim conn As New ADODB.Connection

    Dim rs As New ADODB.Recordset

    Dim rtn As String

    

    inModel = cleanSql(inModel)

    inMake = cleanSql(inMake)

    inType = cleanSql(inType)

    inYear = cleanSql(inYear)

    Set conn = CurrentProject.Connection

    rs.ActiveConnection = conn

    rs.Source = "SELECT ModelId FROM dbo_Model WHERE Model = '" & inModel & "' AND MakeId = " & inMake & " AND TypeId = " & inType & " AND YearId=" & inYear

    rs.Open

    If Not rs.EOF Then

        rtn = rs("ModelID")

    Else

        rtn = "0"

    End If

    getModelId = rtn

End Function



Private Function newModelId(inMake As String, inYear As String, inType As String, inModel As String) As String

    Dim conn As New ADODB.Connection

    Dim cmd As New ADODB.Command

    Dim rtn As String

    

    inMake = cleanSql(inMake)

    inYear = cleanSql(inYear)

    inType = cleanSql(inType)

    inModel = cleanSql(inModel)

    Set conn = CurrentProject.Connection

    cmd.ActiveConnection = conn

    cmd.CommandText = "INSERT INTO dbo_model (MakeID,YearID,TypeID,Model) values (" & inMake & "," & inYear & "," & inType & ",'" & inModel & "')"

    cmd.Execute

    rtn = lastModelId()

    newModelId = rtn

End Function



Private Function getGroupId(inModel As String, inGroup As String) As String

    Dim conn As New ADODB.Connection

    Dim rs As New ADODB.Recordset

    Dim rtn As String

    

    inModel = cleanSql(inModel)

    inGroup = cleanSql(inGroup)

    Set conn = CurrentProject.Connection

    rs.ActiveConnection = conn

    rs.Source = "SELECT GroupId FROM dbo_Parts_Group WHERE ModelId = " & inModel & " AND Group_Name = '" & inGroup & "'"

    rs.Open

    If Not rs.EOF Then

        rtn = rs("GroupID")

    Else

        rtn = "0"

    End If

    getGroupId = rtn

End Function



Private Function newGroupId(inModel As String, inGroup As String, inImgUrl As String) As String

    Dim conn As New ADODB.Connection

    Dim cmd As New ADODB.Command

    Dim rtn As String

    

    inModel = cleanSql(inModel)

    inGroup = cleanSql(inGroup)

    inImgUrl = cleanSql(inImgUrl)

    Set conn = CurrentProject.Connection

    cmd.ActiveConnection = conn

    cmd.CommandText = "INSERT INTO dbo_Parts_Group (ModelID,Group_Name,Image_URL,Group_Viewed) values (" & inModel & ",'" & inGroup & "','" & inImgUrl & "',1)"

    cmd.Execute

    rtn = lastGroupId()

    newGroupId = rtn

End Function



Private Function getPartId(inGroup As String, inRef As String, inPart As String) As String

    Dim conn As New ADODB.Connection

    Dim rs As New ADODB.Recordset

    Dim rtn As String

    

    inGroup = cleanSql(inGroup)

    inRef = cleanSql(inRef)

    inPart = cleanSql(inPart)

    Set conn = CurrentProject.Connection

    rs.ActiveConnection = conn

    rs.Source = "SELECT PartID FROM dbo_Parts_Listing WHERE GroupID = " & inGroup & " AND Part_Ref_Number = '" & inRef & "' AND Part_Number='" & inPart & "'"

    rs.Open

    If Not rs.EOF Then

        rtn = rs("PartID")

    Else

        rtn = "0"

    End If

    getPartId = rtn

    

End Function



Private Function newPartId(inPart As String, inRef As String, inNum As String, inDesc As String, inGroup As String) As String

    Dim conn As New ADODB.Connection

    Dim cmd As New ADODB.Command

    Dim rs As New ADODB.Recordset

    Dim rtn As String

    

    inPart = cleanSql(inPart)

    inRef = cleanSql(inRef)

    inNum = cleanSql(inNum)

    inDesc = cleanSql(inDesc)

    inGroup = cleanSql(inGroup)

    Set conn = CurrentProject.Connection

    cmd.ActiveConnection = conn

    cmd.CommandText = "INSERT INTO dbo_Parts_Listing (Part_Number,Part_Ref_Number,Part_Qty,Part_Description,GroupID) values ('" & inPart & "','" & inRef & "','" & inNum & "','" & inDesc & "'," & inGroup & ")"

    cmd.Execute

    rtn = lastPartId()

    newPartId = rtn

End Function





Private Function lastModelId() As String

    Dim conn As New ADODB.Connection

    Dim rs As New ADODB.Recordset

    Dim rtn As String

    

    Set conn = CurrentProject.Connection

    rs.ActiveConnection = conn

    rs.Source = "SELECT MAX(ModelID) as ID FROM dbo_Model"

    rs.Open

    If Not rs.EOF Then

        rtn = rs("ID")

    Else

        rtn = "0"

    End If

    lastModelId = rtn

End Function



Private Function lastGroupId() As String

    Dim conn As New ADODB.Connection

    Dim rs As New ADODB.Recordset

    Dim rtn As String

    

    Set conn = CurrentProject.Connection

    rs.ActiveConnection = conn

    rs.Source = "SELECT MAX(GroupID) as ID FROM dbo_Parts_Group"

    rs.Open

    If Not rs.EOF Then

        rtn = rs("ID")

    Else

        rtn = "0"

    End If

    lastGroupId = rtn

End Function



Private Function lastPartId() As String

    Dim conn As New ADODB.Connection

    Dim rs As New ADODB.Recordset

    Dim rtn As String

    

    Set conn = CurrentProject.Connection

    rs.ActiveConnection = conn

    rs.Source = "SELECT MAX(PartID) as ID FROM dbo_Parts_Listing"

    rs.Open

    If Not rs.EOF Then

        rtn = rs("ID")

    Else

        rtn = "0"

    End If

    lastPartId = rtn

End Function



Private Function cleanPart(inPart As String) As String

    Dim parseString() As String

    Dim rtn As String

    

    parseString = Split(inPart, " ")

    rtn = parseString(0)

    cleanPart = rtn

End Function



Private Function cleanSql(inString As String) As String

    Dim rtn As String

    

    rtn = Replace(inString, "'", "''")

    cleanSql = rtn



End Function



Private Sub Command1_Click()

    Dim test As String

    test = "asdf:23432:asdf (replaces asdf9ern3k4j9234k98293804)"

    MsgBox Left(test, 5)

    

End Sub

Open in new window

0
Comment
Question by:ronayers
  • 5
  • 3
  • 2
10 Comments
 
LVL 77

Expert Comment

by:peter57r
ID: 33660324
I have only skimmed over the code but i suspect the problems do not lie in the code as such but in your connection to the database.
There is nothing in the code which shows how the connection is being made, so we need that information.

0
 

Author Comment

by:ronayers
ID: 33660333
Its through a System ODBC connection to local host using the default settings.
0
 
LVL 77

Expert Comment

by:peter57r
ID: 33660431
When you test the odbc connection  (from the same machine you have the Access problem on) does it work OK?

Did you ever use the application succesfully before this code was added?

Can you succesfully open the tables used in this code just by double clicking them?

(dbo_Mozenda, dbo_Year, dbo_Model, dbo_Parts_Group, dbo_Parts_Listing, are what I can see)

Does the code halt at a specific line when you get the error?
0
 

Author Comment

by:ronayers
ID: 33660711
The ODBC connection tests successfully. I didn't have an application within access before the developer built the code but i've always been able to use this same access db to connect with all those tables. The debugger shows that it will stop on the "rs.Open" portion of the functions. It mostly stops on the getmodelid function but I've also seen it stop on getyearid as well. Thanks for your help!
0
 
LVL 77

Assisted Solution

by:peter57r
peter57r earned 250 total points
ID: 33661652
Your setup is not something I can replicate. I am still inclined to feel that the code itself is not the issue here although I can't rule that out.  The variable debug lines that you get might even suggest a data problem although if you can view the tables OK by double-clicking them that steers me away from that cause.
I've requested others to take a look.

0
Backup Your Microsoft Windows Server®

Backup all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

 

Author Comment

by:ronayers
ID: 33665038
Thanks for your help peter57r.
0
 
LVL 13

Accepted Solution

by:
Surone1 earned 250 total points
ID: 33677502
if i help fix this do split points with peter, since without him i would not have gotten to this question.
first of all 2 pages mention said errors:

http://tutorials.aspfaq.com/8000xxxxx-errors/80004005-errors.html
http://tutorials.aspfaq.com/8000xxxxx-errors/why-do-i-get-80040e21-errors.html

that is a lot of reasons, so why not add some error handling?


Private Function cleanPart(inPart As String) As String
    Dim parseString() As String
    Dim rtn As String
    on error goto hell
    parseString = Split(inPart, " ")
    rtn = parseString(0)
    cleanPart = rtn
End Function

Private Function cleanSql(inString As String) As String
    Dim rtn As String
   
    rtn = Replace(inString, "'", "''")
    cleanSql = rtn

End Function

Private Sub Command1_Click()
    Dim test As String
    test = "asdf:23432:asdf (replaces asdf9ern3k4j9234k98293804)"
    MsgBox Left(test, 5)
    exit sub
    hell:
MsgBox Err.Description & vbCrLf & Err.Source & vbCrLf & Err.Number
End Sub
0
 

Author Comment

by:ronayers
ID: 33680394
Sure surone1, if you want to split the points, thats not a problem. I've forwarded this on to the original developer who is also currently battling the issue.

Thanks, I will be in touch.
0
 
LVL 13

Expert Comment

by:Surone1
ID: 33681019
well i would need to help first, having the original developer work on it is a plus. but an error description would probably speed things up a bit
0
 

Author Closing Comment

by:ronayers
ID: 33825812
Thanks for the help, seems the developer figured it out.
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Introduction In my previous article (http://www.experts-exchange.com/Microsoft/Development/MS-SQL-Server/SSIS/A_9150-Loading-XML-Using-SSIS.html) I showed you how the XML Source component can be used to load XML files into a SQL Server database, us…
A long time ago (May 2011), I have written an article showing you how to create a DLL using Visual Studio 2005 to be hosted in SQL Server 2005. That was valid at that time and it is still valid if you are still using these versions. You can still re…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
Viewers will learn how to use the UPDATE and DELETE statements to change or remove existing data from their tables. Make a table: Update a specific column given a specific row using the UPDATE statement: Remove a set of values using the DELETE s…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now