PEAK-System Forum

Code: Select all

#If VBA7 And Win64 Then
    ' 64 bit Excel
    Public Declare PtrSafe Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As LongLong)
#Else
    ' 32 bit Excel
    Public Declare Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
#End If

' the CAN Types
Dim myMsgRecv As TPCANMsg
Dim myMsgSend As TPCANMsg
Dim myTimeStamp As TPCANTimestamp
 
 Sub WaitForCANID()
 Sheets("Tabelle1").Activate ' select first Sheet
 Range("A1").Select ' set cursor to A1
 ActiveCell().Value = "CAN-Data"
 ' now Init CAN-USB Channel one with 500K
 ret = CAN_Initialize(PCAN_USBBUS1, PCAN_BAUD_500K)
 If ret = PCAN_ERROR_OK Then ' CAN Init OK?
  MsgBox "CAN Bus OK!", vbInformation ' show MsgBox if OK
  ret = CAN_Read(PCAN_USBBUS1, myMsgRecv, myTimeStamp) ' read from driver
  While (ret = PCAN_ERROR_OK) Or (ret = PCAN_ERROR_QRCVEMPTY) ' read as long a Msg available or queu empty
    ' if a CAN Message was reveived - we send out the CAN-ID+1 DLC1 with 0xFF as dataByte 1 for Test
    If ret = PCAN_ERROR_OK Then ' Msg received
        myMsgSend.ID = myMsgRecv.ID + 1
        myMsgSend.LEN = 1
        myMsgSend.DATA(0) = &HFF
        ret = CAN_Write(PCAN_USBBUS1, myMsgSend)
        If myMsgRecv.MsgType = PCAN_MESSAGE_STANDARD Then ' Msg is 11Bit type
            If myMsgRecv.ID = &H100 Then ' ID of the Message must be 0x100 (HEX)
                ' we put the values in the first sheet in Cell A2 to A11
                ActiveCell(2, 1).Value = myMsgRecv.ID
                ActiveCell(3, 1).Value = myMsgRecv.LEN
                For a = 0 To myMsgRecv.LEN - 1
                    ActiveCell(4 + a).Value = myMsgRecv.DATA(a)
                Next
                CAN_Uninitialize (PCAN_USBBUS1) ' deinit the CAN
                Exit Sub ' end leave the sub
            End If
        End If
    End If
    Sleep (50) ' 50ms sleep and read again:
    ret = CAN_Read(PCAN_USBBUS1, myMsgRecv, myTimeStamp)
  Wend
  
 Else
    MsgBox "Error while init CAN Bus", vbCritical
 End If
    CAN_Uninitialize (PCAN_USBBUS1)
 End Sub

Code: Select all

DWORD device_features;                          ' Device capabilities flag (see FEATURE_*)

Code: Select all

device_features As Long                      ' Device capabilities flag (see FEATURE_*)

Code: Select all

device_features As Long                         ' Device capabilities flag (see FEATURE_*)