Problemer med Insert Into

Hej

Jeg bruger følgende kode til at aggregere en masse data:
Public Function aggreger()
On Error Resume Next
Dim DB As New ADODB.Connection
Dim RecSet As New ADODB.Recordset
Set DB = CurrentProject.Connection
InputTabel = "DSM"
RecSet.Open InputTabel, DB, adOpenKeyset, adLockOptimistic, adCmdTable
ID2 = 0
z2 = -100
i = 1
Do While (RecSet.EOF = False)
    ID1 = RecSet("OBJECTID")
    If ID2 = ID1 Then
        z1 = RecSet("Z")
        z_agg = z_agg + z1
        If z1 > z2 Then
            z_max = z1
        End If
        i = i + 1
        z2 = z1
    Else
        z_mean = z_agg / i
        If ID2 > 0 Then
            StrSQL = "Insert into DSM_agg (OBJECTID, z_mean, z_max) values(ID2, z_mean, z_max)"
            DB.Execute (StrSQL)
        End If
        If i > 1 Then
            i = 1
            z_agg = 0
        Else
            z_agg = RecSet("Z")
        End If
    End If
    ID2 = ID1
    j = j + 1
    RecSet.MoveNext
Loop
End Function

Hvor jeg læser i tabellen DSM og vil skrive til tabellen DSM_agg men der bliver intet skrevet til min tabel DSM_agg. Hvad er det jeg gør forkert?