通过VBA将Ascii值写入串口问题

时间:2018-01-25 01:40:09

标签: vba serial-port ascii

我正在尝试将Excel与某些比例集成。秤使用串行端口进行通信。我可以读得很好,但我需要发送规模的命令。这是读取和写入功能。

    '-------------------------------------------------------------------------------
' CommRead - Read serial port input buffer.
'
' Parameters:
'   intPortID   - Port ID used when port was opened.
'   strData     - Data buffer.
'   lngSize     - Maximum number of bytes to be read.
'
' Returns:
'   Error Code  - 0 = No Error.
'-------------------------------------------------------------------------------
Public Function CommRead(intPortID As Integer, strData As String, _
    lngSize As Long) As Long

Dim lngStatus As Long
Dim lngRdSize As Long, lngBytesRead As Long
Dim lngRdStatus As Long, strRdBuffer As String * 1024
Dim lngErrorFlags As Long, udtCommStat As COMSTAT

    On Error GoTo Routine_Error

    strData = ""
    lngBytesRead = 0
    DoEvents

    ' Clear any previous errors and get current status.
    lngStatus = ClearCommError(udtPorts(intPortID).lngHandle, lngErrorFlags, _
        udtCommStat)

    If lngStatus = 0 Then
        lngBytesRead = -1
        lngStatus = SetCommError("CommRead (ClearCommError)")
        GoTo Routine_Exit
    End If
'---------------------------------------------------------------------------------
'    If udtCommStat.cbInQue > 0 Then
'        If udtCommStat.cbInQue > lngSize Then
'            lngRdSize = udtCommStat.cbInQue
'        Else
'            lngRdSize = lngSize
'        End If
'    Else
'        lngRdSize = 0
'    End If
'------------------------------------------------------------------------------------

    lngRdSize = lngSize
    If lngRdSize Then
        lngRdStatus = ReadFile(udtPorts(intPortID).lngHandle, strRdBuffer, _
            lngRdSize, lngBytesRead, udtCommOverlap)

        If lngRdStatus = 0 Then
            lngStatus = GetLastError
            If lngStatus = ERROR_IO_PENDING Then
                ' Wait for read to complete.
                ' This function will timeout according to the
                ' COMMTIMEOUTS.ReadTotalTimeoutConstant variable.
                ' Every time it times out, check for port errors.

                ' Loop until operation is complete.
                While GetOverlappedResult(udtPorts(intPortID).lngHandle, _
                    udtCommOverlap, lngBytesRead, True) = 0

                    lngStatus = GetLastError

                    If lngStatus <> ERROR_IO_INCOMPLETE Then
                        lngBytesRead = -1
                        lngStatus = SetCommErrorEx( _
                            "CommRead (GetOverlappedResult)", _
                            udtPorts(intPortID).lngHandle)
                        GoTo Routine_Exit
                    End If
                Wend
            Else
                ' Some other error occurred.
                lngBytesRead = -1
                lngStatus = SetCommErrorEx("CommRead (ReadFile)", _
                    udtPorts(intPortID).lngHandle)
                GoTo Routine_Exit

            End If
        End If

        strData = Left$(strRdBuffer, lngBytesRead)
    End If

Routine_Exit:
    CommRead = lngBytesRead
    Exit Function

Routine_Error:
    lngBytesRead = -1
    lngStatus = Err.Number
    With udtCommError
        .lngErrorCode = lngStatus
        .strFunction = "CommRead"
        .strErrorMessage = Err.Description
    End With
    Resume Routine_Exit
End Function

'-------------------------------------------------------------------------------
' CommWrite - Output data to the serial port.
'
' Parameters:
'   intPortID   - Port ID used when port was opened.
'   strData     - Data to be transmitted.
'
' Returns:
'   Error Code  - 0 = No Error.
'-------------------------------------------------------------------------------
Public Function CommWrite(intPortID As Integer, strData As String) As Long

Dim i As Integer
Dim lngStatus As Long, lngSize As Long
Dim lngWrSize As Long, lngWrStatus As Long

    On Error GoTo Routine_Error

    ' Get the length of the data.
    lngSize = Len(strData)

    ' Output the data.
    lngWrStatus = WriteFile(udtPorts(intPortID).lngHandle, strData, lngSize, _
        lngWrSize, udtCommOverlap)

    ' Note that normally the following code will not execute because the driver
    ' caches write operations. Small I/O requests (up to several thousand bytes)
    ' will normally be accepted immediately and WriteFile will return true even
    ' though an overlapped operation was specified.

    DoEvents

    If lngWrStatus = 0 Then
        lngStatus = GetLastError
        If lngStatus = 0 Then
            GoTo Routine_Exit
        ElseIf lngStatus = ERROR_IO_PENDING Then
            ' We should wait for the completion of the write operation so we know
            ' if it worked or not.
            '
            ' This is only one way to do this. It might be beneficial to place the
            ' writing operation in a separate thread so that blocking on completion
            ' will not negatively affect the responsiveness of the UI.
            '
            ' If the write takes long enough to complete, this function will
            ' timeout
            ' according to the CommTimeOuts.WriteTotalTimeoutConstant variable.
            ' At that time we can check for errors and then wait some more.

            ' Loop until operation is complete.
            While GetOverlappedResult(udtPorts(intPortID).lngHandle, _
                udtCommOverlap, lngWrSize, True) = 0

                lngStatus = GetLastError

                If lngStatus <> ERROR_IO_INCOMPLETE Then
                    lngStatus = SetCommErrorEx( _
                        "CommWrite (GetOverlappedResult)", _
                        udtPorts(intPortID).lngHandle)
                    GoTo Routine_Exit
                End If
            Wend
        Else
            ' Some other error occurred.
            lngWrSize = -1

            lngStatus = SetCommErrorEx("CommWrite (WriteFile)", _
                udtPorts(intPortID).lngHandle)
            GoTo Routine_Exit

        End If
    End If

    For i = 1 To 10
        DoEvents
    Next

Routine_Exit:
    CommWrite = lngWrSize
    Exit Function

Routine_Error:
    lngStatus = Err.Number
    With udtCommError
        .lngErrorCode = lngStatus
        .strFunction = "CommWrite"
        .strErrorMessage = Err.Description
    End With
    Resume Routine_Exit
End Function

这可能只是我尝试将字符串输入为Ascii的方式。以下是给出命令手册中的说明:

发送到天平的命令包含ASCII字符集的一个或多个字符。在这里,必须注意以下几点: 仅以大写形式输入命令。然而,单位必须适当地资本化。 命令的可能参数必须彼此分开,并且与命令名称分开 空格(ASCII 32 dec。,在本手册中表示为)。 “text”的可能输入是从32 dec开始的8位ASCII字符集的字符序列。到255分。 每个命令必须由CR LF关闭(ASCII 13 dec。,10 dec。)。

如果我想发送“Z”命令,我会以这种格式发送901310吗?

Private Sub GetWeight1_Click()
Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
    Dim lngStatus As Long
    Dim lngWrStatus As Long
    Dim strData   As String
    Dim lngSize As Long


    intPortID = 4

    strData = "901310"
    lngWrStatus = CommWrite(intPortID, strData)
    'lngStatus = CommRead(intPortID, strData, 12)

也许代码很好但字符串不是。我没有编写这段代码但读取功能运行良好。我只是无法让write函数运行。任何帮助都会很棒!谢谢!

1 个答案:

答案 0 :(得分:0)

根据您提供的设备的说明以及我对发布的代码的作用的理解,似乎需要编写必要的信息才能发送&#34; Z&#34;命令将是&#34; Z&#34;然后是CR / LF组合,即使用

strData = "Z" & vbCrLF

或(如果你想避免内置常量)

strData = "Z" & Chr(13) & Chr(10)