|
Private Sub Command8_Click()
Dim rs As New ADODB.Recordset
Dim rsSource As New ADODB.Recordset
Dim strSQL As String
Dim i As Integer
Dim a As String, b As Long
Dim WhereArray() As String
If IsHere("Newtbl") Then
CurrentDb.Execute "drop table newtbl"
End If
strSQL = "create table Newtbl(流水号 text,备注 text ,产品 text,数量 long)"
CurrentDb.Execute strSQL
strSQL = "select distinct 流水单id from 明细表"
With rsSource
.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
ReDim WhereArray(.RecordCount - 1) As String
For i = 1 To .RecordCount
WhereArray(i - 1) = .Fields(0)
.MoveNext
Next
.Close
End With
With rs
.Open "Newtbl", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 0 To UBound(WhereArray)
strSQL = "select * from 明细表 where 流水单id='" & WhereArray(i) & "'"
rsSource.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
Do While Not rsSource.EOF
a = a & rsSource.Fields(1) & " "
b = b + rsSource.Fields(2)
rsSource.MoveNext
Loop
rsSource.Close
.AddNew
.Fields(0) = WhereArray(i)
.Fields(2) = a
.Fields(3) = b
.Update
a = ""
b = 0
Next
.Close
End With
Set rs = Nothing
Set rsSource = Nothing
DoCmd.OpenTable "Newtbl"
End Sub
Function IsHere(tblName As String) As Boolean
Dim tbl As DAO.TableDef
IsHere = False
For Each tbl In CurrentDb.TableDefs
If tbl.Name = tblName Then
IsHere = True
Exit For
End If
Next
End Function |
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|