|
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim rsResult As ADODB.Recordset
Set rsResult = New ADODB.Recordset
Dim lngSeqNo As Long
Dim lngId As Long
Dim strOrder As String
Dim strStartNo As String
Dim strEndNo As String
Dim strAllSeqNo As String
CurrentProject.Connection.Execute "Delete * from tblOrderResult"
tblOrderResult.Form.Requery
rsResult.Open "select * from tblOrderResult", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rs.Open "select * from tblOrder order by FId,FOrder,FSeqno", CurrentProject.Connection, adOpenStatic, adLockReadOnly
strOrder = ""
lngId = 0
lngSeqNo = 0
Do While Not rs.EOF
If lngId = rs("FId") And strOrder = rs("FOrder") Then
If rs("FSeqNo") - lngSeqNo = 1 Then
strEndNo = rs("FSeqNo")
Else
If strEndNo = "" Then
strAllSeqNo = strAllSeqNo & " " & strStartNo
Else
strAllSeqNo = strAllSeqNo & " " & strStartNo & "-" & strEndNo
End If
'strAllSeqNo = strAllSeqNo & " " & strStartNo & "-" & strEndNo
strStartNo = rs("FSeqNo")
strEndNo = ""
End If
Else
If strEndNo = "" Then
strAllSeqNo = strAllSeqNo & " " & strStartNo
Else
strAllSeqNo = strAllSeqNo & " " & strStartNo & "-" & strEndNo
End If
If lngId <> 0 Then
rsResult.AddNew
rsResult("FId") = lngId
rsResult("FOrder") = strOrder
rsResult("FSeqNo") = Trim(strAllSeqNo)
rsResult.Update
strAllSeqNo = ""
End If
lngId = rs("FId")
strOrder = rs("FOrder")
strStartNo = rs("FSeqNo")
strEndNo = ""
End If
lngSeqNo = rs("FSeqNo")
rs.MoveNext
Loop
If strEndNo = "" Then
strAllSeqNo = strAllSeqNo & " " & strStartNo
Else
strAllSeqNo = strAllSeqNo & " " & strStartNo & "-" & strEndNo
End If
If lngId <> 0 Then
rsResult.AddNew
rsResult("FId") = lngId
rsResult("FOrder") = strOrder
rsResult("FSeqNo") = Trim(strAllSeqNo)
rsResult.Update
End If
tblOrderResult.Form.Requery |
|