Advertisement

06.08.2008 at 05:29PM PDT, ID: 23467794
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
9.8

Recordset VBA Error: Cannot Update: Database or object is read-only

Asked by jacobbarnett in Microsoft Access Database

Tags:

Hello ~

I'm receiving run-time error: 3027 - Cannot update: Database or object is read-only on line 122 of the attached code: "rs3.Edit", attempting to edit a record in rs3. (marked:    '<<<<<<< ERROR HERE)

I have edited records in recordsets before without this error; clearly, I'm missing something here.

I'd appreciate your illumination.

Many Thanks, JacobStart Free Trial 
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:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:

Option Compare Database
Option Explicit
Public varCO As String  'Company designation value: Paint = P, Water = W
 
' References:
' Visual Basic for Applications
' Microsoft Access 11.0 Object Library
' Microsoft DAO 3.6 Object Library
 
'===============================================
 
Public Function DataExport()
'On Error GoTo ReportError
 
Dim db As DAO.Database
Dim rs, rs1, rs2, rs3 As DAO.Recordset
Dim I, I2 As Integer
Dim FileNum As Integer
Dim FileNameAndPath As String
Dim sFill As String
Dim strSQL, strSQL1, strSQL2, strSQL3 As String
Dim DTcode As String
Dim remAmt As Double
Dim vEHDcode As Integer
Dim vEHDtype As String
Dim vindex As Integer
Dim vEmpl As Integer
'Dim vcount As Integer
Dim TLhrs As Integer
Dim MAXhrs As Integer
Dim MAXindex As Integer
 
 
 
 
 
Dim OutputLine As String
 
FileNum = FreeFile()
DTcode = Format(Forms![Main Menu]!ThisWks, "mmdyy")
 
'>> Describes destination path of text file output
'FileNameAndPath = "C:\Data\Computer\Databases\Paystar Exports\" & DTcode & varCO & "_" & "PayStarData.txt"
 
' URBANCO ACTUAL PATH::::::
'FileNameAndPath = "\\Server\Data\Urbanco\Computer\Databases\Paystar Exports\" & DTcode & varCO & "_" & "PayStarData.txt"
 
'JKB's TEST value
varCO = "W"
'JKB's TEST PATH:::::
FileNameAndPath = "c:\" & DTcode & varCO & "_" & "PayStarData.txt"
                
strSQL = "SELECT [Paystar Table for Rpt].*, Employee.*" & _
         " FROM [Paystar Table for Rpt] INNER JOIN Employee ON [Paystar Table for Rpt].Employee = Employee.EmployeeID;"
 
        
    Set rs = CurrentDb.OpenRecordset(strSQL)  ' SET
       
    
If rs.EOF = False Then
    rs.MoveFirst
Else
    MsgBox "No Data", vbExclamation, "Exiting Fuction"
    Set rs = Nothing
    Set db = Nothing
    Exit Function
End If
 
DoCmd.Hourglass True
 
'strSQL1 simply a list of employee IDs to search for
strSQL1 = "SELECT [Paystar Table for Rpt].Employee" & _
          " FROM [Paystar Table for Rpt]" & _
          "GROUP BY [Paystar Table for Rpt].Employee;"
          
'Determine employees with >40 hrs. on combined jobs
'Place hours >40 in CalcOT and decrement job w/ most hrs. worked by (hours >40)
 
    Set rs1 = CurrentDb.OpenRecordset(strSQL1)  ' SET
 
 
rs1.MoveFirst
Do Until rs1.EOF
    vEmpl = rs1!Employee
    
    'strSQL2 creates rs for EACH employee hrs to search for combined OT >40, see WHERE
    strSQL2 = "SELECT [Paystar Table for Rpt].Company AS BCL_Code, [Paystar Table for Rpt].Employee AS Emp_Num," & _
        " '  ' AS Emp_Div, Null AS EHD_Code, Null AS EHD_Type, [Paystar Table for Rpt].SumOfHrs AS Amount," & _
        " '+' AS Plus_Minus, Employee.PayRate AS Rate, [Paystar Table for Rpt].[Paystar ID] AS Labor_Num," & _
        " '      ' AS Clock_Num, '                              ' AS [Emp_Name/SSN]," & _
        " [Paystar Table for Rpt].SumOfBonus, [Paystar Table for Rpt].[SumOfPay Other]," & _
        " [Paystar Table for Rpt].SumOfReimb, [Paystar Table for Rpt].SumOfGrip, [Paystar Table for Rpt].SumOfHrs, [Paystar Table for Rpt].SumOfOThalf," & _
        " [Paystar Table for Rpt].SumOfOTdbl, [Paystar Table for Rpt].SumOfSalary, [Paystar Table for Rpt].Index" & _
        " FROM [Paystar Table for Rpt] INNER JOIN Employee ON [Paystar Table for Rpt].Employee = Employee.EmployeeID" & _
        " WHERE ((([Paystar Table for Rpt].Employee)=" & vEmpl & ") AND (([Paystar Table for Rpt].SumOfHrs)>0 And ([Paystar Table for Rpt].SumOfHrs)<=40));"
    
    Set rs2 = CurrentDb.OpenRecordset(strSQL2)  ' SET
    
        'vcount = 0
        
        TLhrs = 0
        MAXhrs = 0
        MAXindex = 0
            Do Until rs2.EOF
                'vcount = vcount + 1
               TLhrs = TLhrs + rs2!amount
               If rs2!amount > MAXhrs Then
                    MAXhrs = rs2!amount
                    MAXindex = rs2!Index
               End If
                  rs2.MoveNext
            Loop
        If TLhrs > 40 Then
        
strSQL3 = "SELECT [Paystar Table for Rpt].SumOfHrs AS Amount" & _
        " FROM [Paystar Table for Rpt]" & _
        " WHERE ((([Paystar Table for Rpt].Index)=" & MAXindex & "));"
            
    Set rs3 = CurrentDb.OpenRecordset(strSQL3, dbOpenDynaset) ' SET
    
                           
            rs3.Edit   '<<<<<<< ERROR HERE
            rs3!amount = rs3!amount - (TLhrs - 40)
            rs3.Update
            
            rs3.AddNew     '<<<<<<<<<<<<<< NEW RECORD for OT hours HERE     'Add new record w/ OT adjustment
            
            rs3!BCL_Code = rs2!BCL_Code
            rs3!Emp_Num = rs2!Emp_Num
            rs3!Emp_Div = rs2!Emp_Div
            rs3!EHD_Code = rs2!EHD_Code
            rs3!EHD_Type = rs2!EHD_Type
            rs3!amount = (TLhrs - 40) ' OT HRS
            rs3!Plus_Minus = rs2!Plus_Minus
            rs3!Rate = rs2!Rate
            rs3!Labor_Num = rs2!Labor_Num
            rs3!Clock_Num = rs2!Clock_Num
            rs3![Emp_Name/SSN] = rs2![Emp_Name/SSN]
            rs3!SumOfBonus = rs2!SumOfBonus
            rs3![SumOfPay Other] = rs2![SumOfPay Other]
            rs3!SumOfReimb = rs2!SumOfReimb
            rs3!SumOfGrip = rs2!SumOfGrip
            rs3!SumOfHrs = rs2!SumOfHrs
            rs3!SumOfOThalf = (TLhrs - 40)  ' OT HRS
            rs3!SumOfOTdbl = rs2!SumOfOTdbl
            rs3!SumOfSalary = rs2!SumOfSalary
            'rs3!Index = rs2!Index
            
            rs3.Update
        
        Debug.Print vEmpl; TLhrs; MAXindex; MAXhrs
        
        Else
        'bla bla
        End If
    rs1.MoveNext  ' Get next rs1
Loop
        
' NOW run the ORIGINAL function
strSQL = "SELECT [Paystar Table for Rpt].Company AS BCL_Code, [Paystar Table for Rpt].Employee AS Emp_Num," & _
        " '  ' AS Emp_Div, Null AS EHD_Code, Null AS EHD_Type, [Paystar Table for Rpt].SumOfHrs AS Amount," & _
        " '+' AS Plus_Minus, Employee.PayRate AS Rate, [Paystar Table for Rpt].[Paystar ID] AS Labor_Num," & _
        " '      ' AS Clock_Num, '                              ' AS [Emp_Name/SSN]," & _
        " [Paystar Table for Rpt].SumOfBonus, [Paystar Table for Rpt].[SumOfPay Other]," & _
        " [Paystar Table for Rpt].SumOfReimb, [Paystar Table for Rpt].SumOfGrip, [Paystar Table for Rpt].SumOfHrs,[Paystar Table for Rpt].SumOfOThalf," & _
        " [Paystar Table for Rpt].SumOfOTdbl, [Paystar Table for Rpt].SumOfSalary, [Paystar Table for Rpt].Index" & _
        " FROM [Paystar Table for Rpt] INNER JOIN Employee ON [Paystar Table for Rpt].Employee = Employee.EmployeeID;"
        
    Set rs = CurrentDb.OpenRecordset(strSQL)  ' SET
 
'Determine EHD_Code and EHD_Type based on values in:
    'SumOfBonus,[SumOfPay Other], SumOfReimb, SumOfGrip, .SumOfHrs, SumOfOThalf, SumOfOTdbl, SumOfSalary fields
 
'Open the file for output
Open FileNameAndPath For Output Access Write Lock Write As FileNum
I = 0
I2 = 11
remAmt = 0
OutputLine = ""
sFill = ""
 
'start outputting the data
Do Until rs.EOF
    For I = 0 To 10
    
        If I = 0 Then      ' For Field #1  BCL_CODE
            If rs.Fields(I).Value = varCO Then
                If varCO = "P" Then
                OutputLine = OutputLine & "0212"
                ElseIf varCO = "W" Then
                OutputLine = OutputLine & "0213"
                End If
            Else
                GoTo Next1
            End If
            
        ElseIf I = 1 Then      ' For Field #2  EMP_NUM
            sFill = Format(rs.Fields(I).Value, "0000")
            OutputLine = OutputLine & sFill
 
      
        ElseIf I = 2 Then      ' For Field #3 & 4  EHD_Code AND EHD_Type
            sFill = "  000"
            If remAmt > 0 Then     'In this case, call it OT and skip testing
                sFill = "  02H"
            Else
            For I2 = 11 To 18  'Determine EHD_Code AND EHD_Type based on what's in fields 11 -> 18
                
                    If I2 = 11 And rs.Fields(I2).Value > 0 Then  'SumOfBonus
                        sFill = "  09$"
                    ElseIf I2 = 12 And rs.Fields(I2).Value > 0 Then 'SumOfPayOther
                        sFill = "  08$"
                    ElseIf I2 = 13 And rs.Fields(I2).Value > 0 Then 'SumOfReimb
                        sFill = "  07D"
                    ElseIf I2 = 14 And rs.Fields(I2).Value > 0 Then 'SumOfGrip
                        sFill = "  92D"
                    ElseIf I2 = 15 And rs.Fields(I2).Value > 0 Then 'SumofHrs (Reg)
                        sFill = "  01H"
                    ElseIf I2 = 16 And rs.Fields(I2).Value > 0 Then 'SumofOTHalf
                        sFill = "  02H"
                    ElseIf I2 = 17 And rs.Fields(I2).Value > 0 Then 'SumOfOTDbl
                        sFill = "  12H"
                    ElseIf I2 = 18 And rs.Fields(I2).Value > 0 Then 'SumofSalary
                        sFill = "  07$"
                    End If
                
            Next I2
            
            End If
                OutputLine = OutputLine & sFill
 
       ElseIf I = 5 Then  ' For Field #6  Amount
            If remAmt > 0 Then  'Is remAmt >0?
                sFill = Format(remAmt, "0000000.00")
                OutputLine = OutputLine & sFill
                remAmt = 0
                GoTo Next0
            End If
                
            If rs.Fields(I).Value > 40 Then    'Is amount > 40?
                sFill = "0000040.00"
                OutputLine = OutputLine & sFill
                remAmt = rs.Fields(I).Value - 40
                GoTo Next0
            End If
            
            If rs.Fields(I).Value > 0 Then    'Is amount > 0?
                sFill = Format(rs.Fields(I).Value, "0000000.00")
                OutputLine = OutputLine & sFill
                GoTo Next0
            End If
            
            If rs.Fields(I).Value = 0 Then     'Is amount = 0?
            sFill = Format(rs.Fields(I).Value, "0000000.00")
            I2 = 11
                For I2 = 11 To 17  'AMOUNT based on what's in fields 11 -> 18
                
                    If rs.Fields(I2).Value > 0 Then
                        sFill = Format(rs.Fields(I2).Value, "0000000.00")
                    End If
                
                Next I2
            
                OutputLine = OutputLine & sFill
            End If
Next0:
        ElseIf I = 7 Then  ' For Field #8  Rate
            sFill = Format(rs.Fields(I).Value, "00000.00")
            OutputLine = OutputLine & sFill
    
        ElseIf I = 8 Then  ' For Field #9  Labor_Num
            sFill = Format(rs.Fields(I).Value, "00000")
            OutputLine = OutputLine & sFill
            
        Else               ' For Fields: Emp_Div, Plus_Minus, Clock_Num, Emp_Name/SSN
            OutputLine = OutputLine & rs.Fields(I).Value
 
        End If
    Next I
    
    Print #FileNum, OutputLine
    'Debug.Print OutputLine
    OutputLine = ""
    sFill = ""
    
If remAmt > 0 Then GoTo Next2
 
Next1:
    rs.MoveNext
Next2:
Loop
 
 MsgBox "You have successfully exported the PayStarData.txt text file for:" & vbCrLf & vbCrLf & "Company: " & varCO & vbCrLf & "Named: " & DTcode & varCO & "_" & "PayStarData.txt" & vbCrLf & "Located: " & FileNameAndPath, vbInformation, "Export Successful!"
 
ExitProcedure:
  On Error Resume Next
  
  DoCmd.Hourglass False
  
    Close #FileNum
    varCO = ""
    Set rs = Nothing
    Set db = Nothing
 
    Exit Function
 
ReportError:
  Dim msg As String
  msg = "Error in Module UtilityFunction.DataExport:" _
    & vbCr & "Error number " & CStr(Err.Number) _
    & " was generated by " & Err.Source _
    & vbCr & Err.Description
  MsgBox msg, vbExclamation, "Error"
 
  Resume ExitProcedure
  
End Function
[+][-]06.08.2008 at 05:52PM PDT, ID: 21740185

Assisted solutions are selected by the member who asked the question as a comment that contributed to their question's solution.

Start your 7-day free trial to view this Assisted Solution or ask the Experts your question.

 
[+][-]06.08.2008 at 05:53PM PDT, ID: 21740188

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]06.08.2008 at 06:08PM PDT, ID: 21740214

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]06.08.2008 at 06:13PM PDT, ID: 21740224

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]06.08.2008 at 06:41PM PDT, ID: 21740359

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zone: Microsoft Access Database
Tags: Cannot Update: Database or object is read-only
Sign Up Now!
Solution Provided By: harfang
Participating Experts: 2
Solution Grade: A
 
 
[+][-]06.14.2008 at 12:11AM PDT, ID: 21784393

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]06.15.2008 at 11:39AM PDT, ID: 21789302

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]06.15.2008 at 07:35PM PDT, ID: 21790543

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_EXPERT_20070906