导入记录不重复

刚在论坛里边学习了两位老师的代码，并加以组合，现在可以实现追加不重复记录，并显示追加记录数，请老师们看看代码还可以改进吗？
Public Function drsave()
Dim conn
Dim conn2
Dim SQL
Dim rs
Dim a
Dim b
Dim c
'打开原有tblddz,读取表中记录数，并赋值给a
Dim rst1 As DAO.Recordset
Set rst1 = CurrentDb.OpenRecordset("Select * FROM tbldddz orDER BY txmshb")
a = rst1.RecordCount
rst1.Close
Set rst1 = Nothing

Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=admin;Data Source=z:\AccDev_be.mdb"

Set conn2 = CreateObject("ADODB.Connection")
conn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=;Extended properties=Excel 5.0;Data Source=z:\订单模板.xls"

SQL = "Select * FROM [tbldddz$]"
Set rs = conn2.Execute(SQL)
While Not rs.EOF
 SQL = "insert into tbldddz([ddh],[hh],[txbm],[txms],[ddsl],[ddrq],[txmshb]) values('" & fixsql(rs(0)) & "','" & fixsql(rs(1)) & "','" & fixsql(rs(2)) & "','" & fixsql(rs(3)) & "','" & fixsql(rs(4)) & "','" & fixsql(rs(5)) & "','" & fixsql(rs(6)) & "')"
 conn.Execute (SQL)
 rs.MoveNext
Wend
conn.Close
Set conn = Nothing
conn2.Close
Set conn2 = Nothing

Dim rst As DAO.Recordset
Dim strTemp As String
Set rst = CurrentDb.OpenRecordset("Select * FROM tbldddz orDER BY txmshb")
If rst.RecordCount > 0 Then
    rst.MoveFirst
    strTemp = rst!txmshb
    rst.MoveNext
    Do Until rst.EOF
        If rst!txmshb = strTemp Then
            rst.Delete
        Else
            strTemp = rst!txmshb
        End If
        rst.MoveNext
    Loop
End If
'导入后记录集赋值给b
b = rst.RecordCount

rst.Close
Set rst = Nothing
'计算差值
c = b - a
MsgBox "追加记录 " & c & " 条", vbExclamation, "生产管理平台"