The table that it is modifying is a temprorary table, tbl_ImportProductivityB. This table has a total of 9 fields, one of which is just an autonumber. The fields are: CountID, ProdDate, ProdZID, ProdForm, ProdBatch, ProdDoc, ProdICN, ProdKeys, and ProdTime. Five of these fields only have a value if is different from the value of the previous record. These values are not necessarily dependent upon each other, and so therefore don't all change at the same time. In order for me to crunch these records down to totals, I need to fill those blanks with whatever was in the previous row. The five fields are: ProdDate, ProdZID, ProdFrom, ProdBatch, and ProdDoc. The other 4 fields always will have a value, which will be unique to that record. My current function, while it works, is extremely slow, and it balloons the database to about 100x the size (which of course, makes the DB very slow until it can get compacted).
I got the following code, mostly, from someone that I can no longer find. I am really just pretty new to the VBA stuff anyway, and I tried to make it similar to the the other code I have, but of course, I have failed.
The lines that I am quite sure are incorrect are:
Public Function ProcessRecords(.....) As Boolean ' I don't know how these should be defined. When calling the function, it is from a macro, and I am fairly certain that part is correct.
var_CurrentData(Counter) = Nz(!lng_Value1) ' I don't understand why the exclamation mark. The fields are not all long, and I am assuming that is what the lng_Value1 field was supposed to be. And I don't know if the 1 should be (1) for an array.
Any help would be greatly appreciated.
CODE
Public Function ProcessRecords(myTable As String, myField1 As String, myField2 As String, myField3 As String, myField4 As String, myField5 As String, myField6 As String) As Boolean
On Error GoTo Error_ProcessRecords
Dim rst_ProcessData As ADODB.Recordset
Dim var_CurrentData(1 To 5) As Variant
Dim Counter As Byte
Set rst_ProcessData = New ADODB.Recordset
With rst_ProcessData
.CursorLocation = adUseClient
.Properties("Update Resync") = adResyncAll
.Open myTable, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTable
If .BOF And .EOF And .RecordCount > 0 Then Err.Raise vbObject + 5000, "strpf_ProcessRecords", "Unable to open recordset."
.MoveFirst
If .RecordCount = 1 Then
ProcessRecords = False
GoTo Exit_ProcessRecords
End If
.MoveNext
Do Until .EOF
For Counter = 1 To 5
If Nz(.Fields(Counter)) <> 0 Then
var_CurrentData(Counter) = Nz(!lng_Value1)
Else
.Fields(Counter) = var_CurrentData(Counter)
End If
Next Counter
.MoveNext
Loop
End With
ProcessRecords = True
Exit_ProcessRecords:
If Not rst_ProcessData Is Nothing Then If rst_ProcessData.State = adStateOpen Then rst_ProcessData.Close
Set rst_ProcessData = Nothing
Exit Function
Error_ProcessRecords:
ProcessRecords = False
Resume Exit_ProcessRecords
End Function
On Error GoTo Error_ProcessRecords
Dim rst_ProcessData As ADODB.Recordset
Dim var_CurrentData(1 To 5) As Variant
Dim Counter As Byte
Set rst_ProcessData = New ADODB.Recordset
With rst_ProcessData
.CursorLocation = adUseClient
.Properties("Update Resync") = adResyncAll
.Open myTable, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTable
If .BOF And .EOF And .RecordCount > 0 Then Err.Raise vbObject + 5000, "strpf_ProcessRecords", "Unable to open recordset."
.MoveFirst
If .RecordCount = 1 Then
ProcessRecords = False
GoTo Exit_ProcessRecords
End If
.MoveNext
Do Until .EOF
For Counter = 1 To 5
If Nz(.Fields(Counter)) <> 0 Then
var_CurrentData(Counter) = Nz(!lng_Value1)
Else
.Fields(Counter) = var_CurrentData(Counter)
End If
Next Counter
.MoveNext
Loop
End With
ProcessRecords = True
Exit_ProcessRecords:
If Not rst_ProcessData Is Nothing Then If rst_ProcessData.State = adStateOpen Then rst_ProcessData.Close
Set rst_ProcessData = Nothing
Exit Function
Error_ProcessRecords:
ProcessRecords = False
Resume Exit_ProcessRecords
End Function
