Question : Access 2007 - Reserved Error (-1524)

This is very hard to explain, please bear with me...

I am opening an Access 2003 database with newly deployed Access 2007 software.  Access 2007 seems to work very well with our 2003 database, except for one particular item I cannot figure out.  We use this database to generate purchase orders, and when a new purchase order is created I have a VB module that gets the current users full name from the Domain and creates the record for the new PO and them opens the PO form to be filled in.  I have discovered that when I try to write the user name to the record set the following error results:

      "Reserved error (-1524); there is no message for this error."

To get the user name I am using the module "fGetFullNameOfLoggedUser()" that I found here on the exchange.  The module is working properly and returns a sting of the user name.

Important notes: When I run the same script in the older access 2003 software, it runs without any errors.  I have searched the associated table for any corruption, and cannot find any.  I have also run the compact and repair.

During my debugging of this problem I discovered a couple interesting things:
1)  When I set a variable 'DebugUserName = fGetFullNameOfLoggedUser()' it returns the correct user name sting in the Locals window.
2)  When the code hits the line 'MyRS![UserName] = DebugUserName"'it results in the error.
3)  If I manually set the variable with the same string 'DebugUserName = "John Doe"' the module works and writes the string to the table without any errors.

Here is the module that I am having the problem, (it includes my DEBUG entries)...
Note: I have attached the code for the fGetFullNameOfLoggedUser() function as a code snippet.
-------------------------------------------------------------------------------------------------------------------
Private Sub btnOK_Click()
' Error handler
    On Error GoTo Err_btnOK_Click
   
    Dim MyDB As DAO.Database
    Dim MyRS As DAO.Recordset
    Dim POID As Integer
    Dim ProjectID As Double
    Dim JobNumber As String
    Dim LastPONumber As Integer
    Dim NewPONumber As Integer
    Dim NewPO As String
    Dim PONumberID As Integer
    Dim POType As Integer
    Dim stDocName As String
    Dim stLinkCriteria As String
   
    POType = Me.frameSelectPOType
   
'Get ProjectID and Job Number
    Set MyDB = CurrentDb
    Set MyRS = MyDB.OpenRecordset("qryJob-mod")
    ProjectID = MyRS![ProjectID]
    JobNumber = MyRS![JobNumber]
    MyRS.Close
    Set MyRS = MyDB.OpenRecordset("qryPONumber-frm")
    If MyRS.BOF And MyRS.EOF Then
        LastPONumber = 0
    Else
        MyRS.MoveLast
        LastPONumber = MyRS![Number]
    End If
'Set new PO Number
    NewPONumber = LastPONumber + 1
'Adding the new PO to the record set
    MyRS.AddNew
    MyRS![ProjectID] = ProjectID
    MyRS![Number] = NewPONumber
    PONumberID = MyRS![PONumberID]
    MyRS.Update
'Get the new PONumberID
    'MyRS.MoveLast
    'PONumberID = MyRS![PONumberID]
    MyRS.Close

    Set MyRS = MyDB.OpenRecordset("tblPO", dbOpenDynaset)
    MyRS.AddNew
    MyRS![PONumberID] = PONumberID
    MyRS![Date] = Date
    MyRS![BillOfMaterialTypeID] = POType
   
    'DEBUGGING START
    Dim DebugUserName As String
    DebugUserName = fGetFullNameOfLoggedUser()
    'DebugUserName = "John Doe"                    'Used for debugging
    Stop                                              'DEBUG STOP
    MyRS![UserName] = DebugUserName            '<<<<<<<<<   
    Select Case POType
        Case 1
        MyRS![VendorID] = 5                        'Default to Alcan
        MyRS![VendorSalesContactID] = 6               'Defualt to Dyane Poynor
        stDocName = "frmPO - ACM"
       
        Case 6
        MyRS![VendorID] = 19                        'Default to Sapa
        MyRS![VendorSalesContactID] = 22               'Defualt to Lisa Leis
        stDocName = "frmPO - Extrusions"
       
        Case Else
        stDocName = "frmPO"
    End Select

    POID = MyRS![POID]
    MyRS.Update
   
    stLinkCriteria = "[POID]=" & POID
    DoCmd.OpenForm stDocName, , , stLinkCriteria
    DoCmd.Close acForm, "frmPONew" 'Close New PO Form
   
Exit_btnOK_Click:
    Exit Sub
Err_btnOK_Click:
    MsgBox Err.Description
    Resume Exit_btnOK_Click
End Sub

-------------------------------------------------------------------------------------------------------------------

I have attached the code for the fGetFullNameOfLoggedUser() Function
Code Snippet:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
Option Compare Database
Option Explicit

'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Private Type USER_INFO_2
    usri2_name As Long
    usri2_password  As Long  ' Null, only settable
    usri2_password_age  As Long
    usri2_priv  As Long
    usri2_home_dir  As Long
    usri2_comment  As Long
    usri2_flags  As Long
    usri2_script_path  As Long
    usri2_auth_flags  As Long
    usri2_full_name As Long
    usri2_usr_comment  As Long
    usri2_parms  As Long
    usri2_workstations  As Long
    usri2_last_logon  As Long
    usri2_last_logoff  As Long
    usri2_acct_expires  As Long
    usri2_max_storage  As Long
    usri2_units_per_week  As Long
    usri2_logon_hours  As Long
    usri2_bad_pw_count  As Long
    usri2_num_logons  As Long
    usri2_logon_server  As Long
    usri2_country_code  As Long
    usri2_code_page  As Long
End Type
 
Private Declare Function apiNetGetDCName _
    Lib "netapi32.dll" Alias "NetGetDCName" _
    (ByVal servername As Long, _
    ByVal DomainName As Long, _
    bufptr As Long) As Long
 
' function frees the memory that the NetApiBufferAllocate
' function allocates.
Private Declare Function apiNetAPIBufferFree _
    Lib "netapi32.dll" Alias "NetApiBufferFree" _
    (ByVal buffer As Long) _
    As Long
 
' Retrieves the length of the specified wide string.
Private Declare Function apilstrlenW _
    Lib "kernel32" Alias "lstrlenW" _
    (ByVal lpString As Long) _
    As Long
 
Private Declare Function apiNetUserGetInfo _
    Lib "netapi32.dll" Alias "NetUserGetInfo" _
    (servername As Any, _
    UserName As Any, _
    ByVal level As Long, _
    bufptr As Long) As Long
 
' moves memory either forward or backward, aligned or unaligned,
' in 4-byte blocks, followed by any remaining bytes
Private Declare Sub sapiCopyMem _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)
 
Private Declare Function apiGetUserName Lib _
    "advapi32.dll" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, _
    nSize As Long) _
    As Long
 
Private Const MAXCOMMENTSZ = 256
Private Const NERR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234&
Private Const MAX_CHUNK = 25
Private Const ERROR_SUCCESS = 0&
 
Function fGetFullNameOfLoggedUser(Optional strUserName As String) As String
'
' Returns the full name for a given UserID
'   NT/2000 only
' Omitting the strUserName argument will try and
' retrieve the full name for the currently logged on user
'
On Error GoTo ErrHandler
Dim pBuf As Long
Dim dwRec As Long
Dim pTmp As USER_INFO_2
Dim abytPDCName() As Byte
Dim abytUserName() As Byte
Dim lngRet As Long
Dim i As Long
 
    ' Unicode
    abytPDCName = fGetDCName() & vbNullChar
    If (Len(strUserName) = 0) Then strUserName = fGetUserName()
    abytUserName = strUserName & vbNullChar
 
    ' Level 2
    lngRet = apiNetUserGetInfo( _
                            abytPDCName(0), _
                            abytUserName(0), _
                            2, _
                            pBuf)
    If (lngRet = ERROR_SUCCESS) Then
        Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
        fGetFullNameOfLoggedUser = fStrFromPtrW(pTmp.usri2_full_name)
    End If
 
    Call apiNetAPIBufferFree(pBuf)
ExitHere:
    Exit Function
ErrHandler:
    fGetFullNameOfLoggedUser = vbNullString
    Resume ExitHere
End Function
 
Function fGetUserName() As String
' Returns the network login name
Dim lngLen As Long, lngRet As Long
Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngRet = apiGetUserName(strUserName, lngLen)
    If lngRet Then
        fGetUserName = Left$(strUserName, lngLen - 1)
    End If
End Function
 
Function fGetDCName() As String
Dim pTmp As Long
Dim lngRet As Long
Dim abytBuf() As Byte
 
    lngRet = apiNetGetDCName(0, 0, pTmp)
    If lngRet = NERR_SUCCESS Then
        fGetDCName = fStrFromPtrW(pTmp)
    End If
    Call apiNetAPIBufferFree(pTmp)
End Function
 
Private Function fStrFromPtrW(pBuf As Long) As String
Dim lngLen As Long
Dim abytBuf() As Byte
 
    ' Get the length of the string at the memory location
    lngLen = apilstrlenW(pBuf) * 2
    ' if it's not a ZLS
    If lngLen Then
        ReDim abytBuf(lngLen)
        ' then copy the memory contents
        ' into a temp buffer
        Call sapiCopyMem( _
                abytBuf(0), _
                ByVal pBuf, _
                lngLen)
        ' return the buffer
        fStrFromPtrW = abytBuf
    End If
End Function

Answer : Access 2007 - Reserved Error (-1524)

could be ....try using the Trim function
     DebugUserName = Trim(fGetFullNameOfLoggedUser())
Random Solutions  
 
programming4us programming4us