Hallo Zusammen,
Aus einer Exelatabelle sollen Hex Commandos gelsenen werden und an eine Com geschickt werdden.
Das schicken und empfangen funktioniert schon.
Bsp. 0230 3947 5054 5F30 3030 3030 3030 3036 3241 3003
Das Problem ist das eine verkehrte Zeichenkette gesendet wird.
In einem Simulator mit der Com-Schnitstelle 4 verbunden ist, wurde volgendens im Puffer ausgegeben:
"3032 3330 2033 3934 3720 3436 3536 2035 4633 3020 3330 3330 2033 3033 3020 3330 3330 2033 3034 3520 3330 3334 2034 3230 3320 "
habe es auch mit dem geleichen Bsp. blos ohene den Leerzeichen ausprobiert und der Puffer in an Com 4 Schnittstelle(Simulator) gab mir volgendes aus
"3032 3330 3339 3437 3436 3536 3546 3330 3330 3330 3330 3330 3330 3330 3330 3435 3330 3334 3432 3033 "
Wenn ich das gleiche Comando über eine Virtuelle Schnitstelle (von Setup com0om) (Com 3) schicke, wird mir volgender Wert im Puffer ausgegeben:
"0230 3947 5054 5F30 3030 3030 3030 3036 3241 3003 " dieser ist Richtig.
Die Frage ist wie muss ich die Variable "strData" Vormatieren oder Umwandeln, da dieser momenatan (warscheinlich) als string gesendet wird.
Mit dem Befehl "&H" komme ich nicht weiter, da der Comandowert (Hex) als Variable genutz werden soll.
____________________________________
Sub CommWrite_Button()
Dim lngStatus As Long
Dim strData As String
Dim Celle As Variant
Celle = Range("A1")
strData = Celle
intPortID = 3
'Writa data
lngStatus = CommWrite(intPortID, strData)
MsgBox ("Wert an COM geschickt")
End Sub
______________________________________________________
volgender Quellcode von: http://dev.emcelettronica.com/serial-port-communication-in-excel-vba
'-------------------------------------------------------------------------------
' 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
Über Anregungen oder Lösungsansätze würde ich mich freuen,
danke schon mal im Vorraus
LG Marc
|