看看这个对你有没有用
用了mscommPrivate Static Sub MSComm1_OnComm()
Dim tt As Integer
Dim pok As Integer
Dim EVMsg$
Dim ERMsg$
Dim buffer As Variant
Dim nn_user_id As String
Dim mm_user_id As String
Dim tt_1 As Integer
Dim tt_2 As Integer
Dim tt_f As Integer
Dim i As Integer
    Select Case MSComm1.CommEvent
       Case comEvReceive
          MSComm1.InputMode = comInputModeText
          MSComm1.InputLen = 1
          buffer = MSComm1.Input
          
          If buffer = Chr$(2) Then
              txtTerm.Text = ""
              Text2.Text = ""
          End If
        
          If Asc(buffer) = 21 Then
              txtTerm.Text = ""
              txtTerm.Text = "二道数据出错"
              Text2.Text = ""
              Text2.Text = "三道数据出错"
              wrf = True
              Exit Sub
          End If
         'Debug.Print "Receive - " & StrConv(buffer, vbUnicode)
          If buffer <> Chr$(2) And buffer <> Chr$(3) Then
              If buffer = ";" Then
                  wt.Value = False
              End If
              If buffer = "+" Then
                  wt.Value = True
              End If
              If wt.Value = False Then
                    ShowData txtTerm, StrConv(buffer, vbUnicode)
                  If buffer = "?" Then
                        If txtTerm.Text = "" Then
                           txtTerm.Text = ""
                           txtTerm.Text = "二道数据为空"
                        End If
                   End If
              Else
                     ShowData Text2, StrConv(buffer, vbUnicode)
                  If buffer = "?" Then
                      If Text2.Text = "" Then
                           Text2.Text = ""
                           Text2.Text = "三道数据为空"
                       End If
                  End If
               End If
          End If
        
       Case comEvSend
       Case comEvCTS
       Case comEvDSR
       Case comEvCD
       Case comEvRing
       Case comEvEOF
       Case comBreak
       Case comCDTO
       Case comCTSTO
       Case comDCB
       Case comDSRTO
       Case comFrame
       Case comOverrun
       Case comRxOver
       Case comRxParity
       Case comTxFull
       Case Else
          
    End Select
    
    If Len(EVMsg$) Then
        Timer2.Enabled = True
    ElseIf Len(ERMsg$) Then
        Beep
        Ret = MsgBox(ERMsg$, 1, "Click Cancel to quit, OK to ignore.")
        If Ret = 2 Then
            MSComm1.PortOpen = False    ' Close the port and quit.
        End If
        Timer2.Enabled = True
    End If
End SubPrivate Static Sub ShowData(Term As Control, Data As String)
    On Error GoTo Handler
    Const MAXTERMSIZE = 16000
    Dim TermSize As Long, i
    
    ' Make sure the existing text doesn't get too large.
    TermSize = Len(Term.Text)
    If TermSize > MAXTERMSIZE Then
       Term.Text = Mid$(Term.Text, 4097)
       '返回指定为4097个字符
       TermSize = Len(Term.Text)
    End If    ' Point to the end of Term's data.
    Term.SelStart = TermSize    ' Filter/handle BACKSPACE characters.
    
    Do
       i = InStr(Data, Chr$(8))
       
       If i Then
          If i = 1 Then
             Term.SelStart = TermSize - 1
             Term.SelLength = 1
             Data = Mid$(Data, i + 1)
          Else
             Data = Left$(Data, i - 2) & Mid$(Data, i + 1)
          End If
       End If
    Loop While i    ' Eliminate line feeds.
    Do
       i = InStr(Data, Chr$(10))
       
       If i Then
          Data = Left$(Data, i - 1) & Mid$(Data, i + 1)
       End If
    Loop While i    ' Make sure all carriage returns have a line feed.
    i = 1
    Do
       i = InStr(i, Data, Chr$(13))
       
       If i Then
          Data = Left$(Data, i) & Chr$(10) & Mid$(Data, i + 1)
          i = i + 1
       End If
    Loop While i    Term.SelText = Data
  
    If hLogFile Then
       i = 2
       Do
          Err = 0
          Put hLogFile, , Data
          If Err Then
             i = MsgBox(Error$, 21)
             If i = 2 Then
                
             End If
          End If
       Loop While i <> 2
    End If
    Term.SelStart = Len(Term.Text)
Exit SubHandler:
    MsgBox Error$
    Resume Next
End Sub