请教大家一个mscomm串口通信的问题

我使用下边的程序测试串口通信，结果总是出现CTS timeout的错误，请大家帮忙分析一下问题出在哪里，谢谢！Option Explicit
Dim StartFlag As Integer 'Start Flag
Dim TimerCount As Integer 'Timeout(RS232)
Dim Timeout As Integer 'Timeout
Dim CtsFlag As Integer 'CTS Flag
Dim term As String 'Terminator
Dim Query(3) As String 'Query String
Dim Dummy As Integer
Private Function InitSerial() As Integer
Dim rat As String
MSComm1.CommPort = 1 'Port = COM1
rat = "19200,N,8,1" 'Rate = 19200, NoParity, 8Bit, 1Stopbit
MSComm1.Settings = rat
MSComm1.Handshaking = comRTS 'Handshake = CTS-RTS
MSComm1.RTSEnable = True 'RTS = TRUE
CtsFlag = 1
term = Chr(10) 'Terminator = LF
Timeout = 10 'Timeout = 10s
InitSerial = 0
End Function
Private Sub DIsplayRS232Error(ByVal erm As String, Optional ByVal msg As String = "")
MsgBox (erm + Chr(13) + msg), vbExclamation, "Error!"
End Sub
'----------------------------------------------------------------------------------------
Private Sub Command1_Click() 'Run Sample4(RS232) Set/Get TDIV ()
Dim sts As Integer
If (StartFlag = 1) Then
Exit Sub
End If
StartFlag = 1
Text1.Text = "START"
List1.Clear
sts = RS232Tdiv
If (sts = 0) Then
List1.AddItem Query(0)
End If
Text1.Text = "END"
StartFlag = 0
End Sub
Private Sub MSComm1_OnComm()
Dim evt As Integer
evt = MSComm1.CommEvent
Select Case evt
'Error
Case comBreak
Call DIsplayRS232Error("comBreak:Break received")
Case comCDTO
Call DIsplayRS232Error("comCDTO CD(RLSD) timeout")
Case comCTSTO
Call DIsplayRS232Error("comCTSTO:CTS timeout")
Case comDSRTO
Call DIsplayRS232Error("commDSRTO:DSR timeout")
Case comFrame
Call DIsplayRS232Error("comFrame:Frame error")
Case comOverrun
Call DIsplayRS232Error("comOverrun:Overrun")
Case comRxOver
Call DIsplayRS232Error("comRxOver:Receive buffer overflow")
Case comRxParity
Call DIsplayRS232Error("commRxParity:Parity error")
Case comTxFull
Call DIsplayRS232Error("comTxFull:Send buffer overflow")
'Event
Case comEvReceive
Case comEvCD
Case comEvCTS
Case comEvDSR
Case comEvRing
Case comEvSend
End Select
End Sub
Private Sub Timer1_Timer()
TimerCount = TimerCount + 1
End Sub
'----------------------------------------------------------------------------------------
'Sample4(RS232) Set/Get TDIV
'--------------------------------------------------------------------
Private Function RS232Tdiv() As Integer
Dim msg As String 'Command buffer
Dim qry As String 'Query biffer
Dim sts As Integer
msg = Space$(100)
qry = CStr(Empty)
sts = InitSerial 'Initialize RS232
If (sts <> 0) Then
Exit Function
End If
MSComm1.InputLen = 0 'Receive All Data
MSComm1.InputMode = comInputModeText 'Text Mode
MSComm1.PortOpen = True 'Port Open
MSComm1.OutBufferCount = 0 'Out Buffer Clear
MSComm1.InBufferCount = 0 'In Buffer Clear
Timer1.Interval = 1000
If CtsFlag = 1 Then 'If CTS = FALSE
TimerCount = 1 'Wait until CTS = TRUE
Do
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("CTS Timeout")
RS232Tdiv = 1
GoTo finish
End If
Loop Until MSComm1.CTSHolding = True
End If
msg = "TIMEBASE:TDIV 2ms" + term 'Set T/div = 2ms
MSComm1.Output = msg 'Send Command
TimerCount = 1
Do 'Wait until OutBufferCount = 0
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg)
RS232Tdiv = 1
GoTo finish
End If
Loop Until MSComm1.OutBufferCount = 0
msg = "TIMEBASE:TDIV?" + term 'Get T/div value
MSComm1.Output = msg 'Send Command
TimerCount = 1
Do 'Wait until OutBufferCount = 0
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Send Timeout", msg)
RS232Tdiv = 1
GoTo finish
End If
Loop Until MSComm1.OutBufferCount = 0
TimerCount = 1
Do 'Receive Query
qry = qry + MSComm1.Input 'Wait until End Data = Terminator
Dummy = DoEvents()
If (TimerCount >= Timeout) Then
Call DIsplayRS232Error("Receive Timeout", msg)
RS232Tdiv = 1
GoTo finish
End If
Loop Until Right$(qry, 1) = term
Query(0) = Left$(qry, Len(qry) - 1)
RS232Tdiv = 0
finish:
MSComm1.PortOpen = False 'Port Close
Timer1.Interval = 0
End Function
'--------------------------------------------------------------------