If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Reserved Error - 1104 - Works in 97 not in XP?
Hi Everyone,
I've built a custom application for the company I work for that reads each workgroup file for all the Access databases we support and extracts each user and their corresponding login information and inserts it into a table. Now, it works fine in Access 97, however, in XP, I get the follwing error (Run-time Error #3000, Reserved Error -1104, The is no message for this error.) It just about always crashes when around 250 records are added to the table. I've hypothesized it may have to do with the to many objects open at once. Does anyone have any ideas? Here's my code: Public Function getDBUsers() On Error GoTo Err_getDBUsers Dim db As DAO.Database Dim rs_dbs As DAO.Recordset Dim x As Integer Set db = CurrentDb() Set rs_dbs = db.OpenRecordset("Select * From qryAccessDatabases;") rs_dbs.MoveLast rs_dbs.MoveFirst Do Until rs_dbs.EOF Call getUserNames(rs_dbs!intDatabaseID, rs_dbs!Database, rs_dbs!Workgroup, rs_dbs!strUserID, rs_dbs!strPassword) rs_dbs.MoveNext Loop Exit_getDBUsers: Set db = Nothing Set rs_dbs = Nothing Exit Function Err_getDBUsers: MsgBox "Error: " & Err.Number & Chr(13) & Chr(10) & Err.Description Resume Exit_getDBUsers End Function Public Function getUserNames(db_id As Integer, db_database As String, db_workgroup As String, db_userid As String, db_password As String) On Error GoTo Err_getUserNames Dim dbe As PrivDBEngine Dim wrk As DAO.Workspace Dim dbs As DAO.Database Dim usr As DAO.User Dim grp As DAO.Group Dim User_ID As Long Dim database_id As Long Dim strUser As String Dim strGroup As String Dim password_blank As Boolean Dim groups As String Set dbe = New PrivDBEngine dbe.SystemDB = db_workgroup dbe.DefaultUser = db_userid dbe.DefaultPassword = db_password Set wrk = dbe.Workspaces(0) Set dbs = wrk.OpenDatabase(db_database) For Each usr In wrk.Users strUser = usr.Name groups = "" password_blank = isBlankPassword(strUser) For Each grp In wrk.groups strGroup = grp.Name If userInGroup(strUser, strGroup, wrk) = True Then groups = groups & strGroup & "," End If Next grp If groups "" Then groups = Left(groups, Len(groups) - 1) End If Call addUser(strUser, db_id, groups, password_blank) Next usr Set dbe = Nothing dbs.Close Set dbs = Nothing Exit_getUserNames: Set dbs = Nothing Exit Function Err_getUserNames: If Err.Number = 3028 Then MsgBox "The following database has become corrupt or is missing. User information cannot be obtained." & Chr(13) _ & Chr(13) & "Database: " & db_database _ & Chr(13) & "Workgroup: " & db_workgroup _ & Chr(13) & Chr(13) & "Repair this database and run this operation again.", vbCritical + vbOKOnly, "Import Failed!" Else MsgBox "Error: " & Err.Number & Chr(13) & Chr(10) & Err.Description End If Resume Exit_getUserNames End Function Public Function userInGroup(user_name As String, group_name As String, ByRef wrk As Workspace) As Boolean On Error GoTo Err_userInGroup Dim usr As User Dim grp As Group Set grp = wrk.groups(group_name) For Each usr In grp.Users If usr.Name = user_name Then userInGroup = True Exit Function End If Next usr Exit_userInGroup: Exit Function Err_userInGroup: MsgBox "Error: " & Err.Number & Chr(13) & Chr(10) & Err.Description Resume Exit_userInGroup End Function Public Function isBlankPassword(user_name As String) As Boolean On Error GoTo Err_isBlankPassword Dim wrkTest As Workspace Dim result As Boolean Const errInvalidPassword = 3029 On Error Resume Next Set wrkTest = DBEngine.CreateWorkspace("Test", user_name, "") result = (Err = errInvalidPassword) If result = True Then isBlankPassword = False Else isBlankPassword = True End If Exit_isBlankPassword: Exit Function Err_isBlankPassword: MsgBox "Error: " & Err.Number & Chr(13) & Chr(10) & Err.Description Resume Exit_isBlankPassword End Function Public Function addUser(strUser As String, db_id As Integer, db_permissions As String, isblank As Boolean) On Error GoTo Err_addUser Dim sql As String sql = "INSERT INTO tblDBUsers ( database_id, strUserName, strPermissions, blankPassword, [date] ) " _ & "SELECT " & db_id & " AS Expr1, '" & strUser & "' AS Expr2, '" & db_permissions & "' AS Expr3, " & isblank & " AS Expr4, Now() AS Expr5;" DoCmd.RunSQL (sql) Exit_addUser: Exit Function Err_addUser: MsgBox "Error: " & Err.Number & Chr(13) & Chr(10) & Err.Description End Function |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How do I convert works file to excel without works software? | CatMB | General Discussion | 1 | June 21st, 2005 04:12 PM |
How do you open a Works 6.0 doc with Word 2002? | capnhowdyox | General Discussion | 1 | May 3rd, 2005 02:21 PM |
Unable to install Word 2002 as a part of Microsoft Works Suite 20. | Cindy M -WordMVP- | General Discussion | 0 | April 26th, 2005 10:22 AM |
VBA Code problem error 9 | Speedy | General Discussion | 19 | October 15th, 2004 09:05 PM |
Works Vs. Office | General Discussions | 6 | August 3rd, 2004 08:35 PM |