Scanned "string" data collection

The following code is being used to read passing pallets using an infra red scanner and this string is then being transferred to a data base, is there an easier way to record some of the data scanned? There are some errors appearing in the transfer to the data base and in some cases the data is being replicated. Any help on this would be appreciated. The code being used is as follows

Code:

---

Option Compare Database

Private Sub Command3_Click()

    Dim strInput As Variant
    Dim PalletID As Variant
   
    strInput = "TT=___90ms MG=_49% n=_1 AK=1101C128 _57% ST=0 CP=_49 CL=_3 CA=__6 CS=__4 CK=__2 DI=F"
   
    PalletID = Mid(strInput, 6 + InStr(1, strInput, "AK=1", vbBinaryCompare), 3)
   
    With Text1
   
        .SetFocus
        .Text = PalletID
       
    End With
     
    'MsgBox (PalletID)
 
End Sub

Private Sub Form_Load()
       
        With MSComm0
            .CommPort = 1
            .Handshaking = 2
            .RThreshold = 1
            .RTSEnable = True
            .Settings = "9600,n,8,1"
            .SThreshold = 1
            .PortOpen = True
        End With
End Sub


Private Sub Form_Unload(Cancel As Integer)
    MSComm0.PortOpen = False
End Sub


Private Sub MSComm0_OnComm()
  Dim strInput As Variant
  Dim PalletID As Variant
 
 
    Dim rst As DAO.Recordset
    Dim sID As DAO.Field
    Dim sCell As DAO.Field
    Dim sTime As DAO.Field
       
   
   
  With MSComm0
   
    Select Case .CommEvent
      Case comEvReceive
       
        strInput = .Input
        'Me.TimerInterval = 2000
        'PalletID = Left(strInput, 20)

        PalletID = Mid(strInput, 2 + InStr(1, strInput, Chr(13), vbTextCompare), 5)
        Me.TimerInterval = 2000
        'MsgBox (PalletID)
            'Text1.SelText = PalletID & Chr(13)
            'Text1.SelText = strInput
       
       
            Set rst = CurrentDb.OpenRecordset("SELECT * FROM Table1", dbOpenDynaset)
            Set sID = rst("ID")
            Set sCell = rst("Cell")
            Set sTime = rst("Time")
   
            rst.AddNew
            sID = PalletID
            sCell = .InBufferCount
            sTime = Time
   
            rst.Update

            rst.Close
            Set rst = Nothing
           
                     
       
        'Call WriteFile("c:\test.txt")
       
    End Select
  End With 'MSComm0
End Sub


Public Sub WriteFile(FileName As String)
    Dim i As Integer
    i = FreeFile
    Open FileName For Append As #i
    Print #i, strInput
    Close #i
End Sub

---