Excel VBA for IOWarrior and Sensirion SHT7x

This is the English forum for all topics related to IO-Warrior. Please post in English only

Moderator: Guido Körber

Post Reply
Christof
Posts: 3
Joined: Fri Aug 03, 2012 1:19 pm

Excel VBA for IOWarrior and Sensirion SHT7x

Post by Christof »

Just a quick post to let you know that I have managed to produce an Excel VBA script that can read from multiple IOWarrior devices with attached SHT7X temperature and humidity sensors. If anyone is interested I can send the necessary code.
User avatar
Christoph Jung
Posts: 670
Joined: Sun Oct 08, 2006 3:43 pm
Location: Germany / Berlin
Contact:

Re: Excel VBA for IOWarrior and Sensirion SHT7x

Post by Christoph Jung »

Can you send me a copy for our support?

jung@codemercs.com
Abteilung: Softwareentwicklung
Folge uns auf Twitter
Follow us on twitter
Christof
Posts: 3
Joined: Fri Aug 03, 2012 1:19 pm

Re: Excel VBA for IOWarrior and Sensirion SHT7x

Post by Christof »

Accessing the Sensirion SHT7x through the IOWarrior is easy with VBA. I am not a programmer, so forgive my poor coding techniques....

First, put the iowkit.dll in the System32 directory so that Excel can find it.
Then declare all the usual functions for it (as below). I have changed the structure of a few of the datatypes to a custom type called Eight (which is just made up of two longs).

Code: Select all

Private Type Eight
    Long1 As Long
    Long2 As Long
End Type

' IO-Warrior low-level library API functions
Public Declare Function IowKitOpenDevice Lib "iowkit" () As Long
Public Declare Sub IowKitCloseDevice Lib "iowkit" (ByVal iowHandle As Long)
Public Declare Function IowKitWrite Lib "iowkit" (ByVal iowHandle As Long, ByVal numPipe As Long, ByRef buffer As Eight, ByVal length As Long) As Long
Public Declare Function IowKitRead Lib "iowkit" (ByVal iowHandle As Long, ByVal numPipe As Long, ByRef buffer As Byte, ByVal length As Long) As Long
Public Declare Function IowKitReadNonBlocking Lib "iowkit" (ByVal iowHandle As Long, ByVal numPipe As Long, ByRef buffer As Eight, ByVal length As Long) As Long
Public Declare Function IowKitReadImmediate Lib "iowkit" (ByVal iowHandle As Long, ByRef value As Long) As Long

' Get number of IOW devices
Public Declare Function IowKitGetNumDevs Lib "iowkit" () As Long

' Get Nth IOW device handle
Public Declare Function IowKitGetDeviceHandle Lib "iowkit" (ByVal numDevice As Long) As Long
Public Declare Function IowKitSetLegacyOpenMode Lib "iowkit" (ByVal openMode As Long) As Long
Public Declare Function IowKitGetProductId Lib "iowkit" (ByVal iowHandle As Long) As Long
Public Declare Function IowKitGetRevision Lib "iowkit" (ByVal iowHandle As Long) As Long
Public Declare Function IowKitGetThreadHandle Lib "iowkit" (ByVal iowHandle As Long) As Long
Public Declare Function IowKitGetSerialNumber Lib "iowkit" (ByVal iowHandle As Long, ByRef SerialNumber As Byte) As Long
Public Declare Function IowKitSetTimeout Lib "iowkit" (ByVal iowHandle As Long, ByVal TimeOut As Long) As Long
Public Declare Function IowKitSetWriteTimeout Lib "iowkit" (ByVal iowHandle As Long, ByVal TimeOut As Long) As Long
Public Declare Function IowKitCancelIo Lib "iowkit" (ByVal iowHandle As Long, ByVal numPipe As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
As in the previous VB code do the usual opening of the device:

Code: Select all

iowHandles(0) = IowKitOpenDevice()
Find out how many are attached:

Code: Select all

    numIOWs = IowKitGetNumDevs()
And iterate through the remaining ones and get their handles:

Code: Select all

    For I = 2 To numIOWs
        iowHandles(I - 1) = IowKitGetDeviceHandle(I)
    Next I
Now the fun begins. Each device needs to be set-up with these writes and reads by calling this function, passing it the device handles array like this:

Code: Select all

    a = FirstTimeSetup(iowHandles)

Code: Select all

Public Function FirstTimeSetup(iowHandles)
    Dim iowHandle As Variant, Res As Long
    For Each iowHandle In iowHandles
        Res = WriteHex(iowHandle, &HC00101)
        Res = WriteHex(iowHandle, &HC00101)
        Res = WriteHex(iowHandle, &H70203)
        Res = MyRead(iowHandle)
    'setup to get temp and humidity
        Res = WriteHex(iowHandle, &H70203)
        Res = MyRead(iowHandle)
        Res = WriteHex(iowHandle, &H68202)
        Res = MyRead(iowHandle)
    Next
End Function
Now, all should be in place to request humidity and temperature. I have created two functions for that which take the device handle. GetTemperature is the simplest since it just returns the temperature with no additional maths necessary (the function uses the calibration values given in the Sensirion datasheet for the appropriate bit depth and USB voltage):

Code: Select all

Public Function GetTemperature(iowHandle) As Double
    Dim Res As Long, Temperature As Double
    Res = WriteHex(iowHandle, &H30303)
    Temperature = MyRead(iowHandle)
    GetTemperature = -40.1 + (0.01 * Temperature)
End Function
Where, WriteHex is:

Code: Select all

Private Function WriteHex(hndl, value As Long)
    Dim SendVal As Eight
    SendVal.Long2 = 0
    SendVal.Long1 = value
    WriteHex = IowKitWrite(hndl, 1, SendVal, 8)
    If WriteHex = 0 Then MsgBox ("Write failed")
End Function
and, MyRead is this function:

Code: Select all

Private Function MyRead(iowHandle)
    Res As Long, S(8) As Byte
    Do
        Res = IowKitRead(iowHandle, 1, S(0), 8)
    Loop Until Res > 0
    MyRead = Swap(S)
End Function
And Swap(S) does the big/little endian stuff:

Code: Select all

Private Function Swap(S)
    Swap = S(2) * 256 + S(3) + S(4) / 256
End Function
Getting humidity is a bit more tricky....you could use this function (which takes the device handle and temperature). It first turns the output into a linear function of relative humidity, then it makes a correction for temperature (again described on the Sensirion datasheet):

Code: Select all

Public Function GetHumidity(iowHandle, Temperature As Double) As Double
    Dim Res As Long, RHO As Double, RH As Double
    If Temperature > 0 Then
        Res = WriteHex(iowHandle, &H50303)
        RHO = MyRead(iowHandle)
        RH = -2.0468 + 0.0367 * RHO + (-1.5955 * 10 ^ -6 * RHO ^ 2)
        GetHumidity = (Temperature - 25) * (0.01 + 0.00008 * RHO) + RH
    End If
End Function
Or, you could just get the raw output and process it within the spreadsheet:

Code: Select all

Public Function GetRawHumidity(iowHandle) As Integer
    Dim Res As Long
    Res = WriteHex(iowHandle, &H50303)
    GetRawHumidity = MyRead(iowHandle)
End Function
Finally, when you have read enough temperatures and humidities don't forget to close the device:

Code: Select all

    IowKitCloseDevice (iowHandles(0))
Also, don't hit the devices at too high a rate - you can see them warming-up. Use a timing loop - my suggestion is to use GetTickCount which returns millisecond accuracy and a Do until loop with DoEvents so that Excel still responds to user input.

Anyway, hopefully that should allow you VBA coders to have some fun!
jmmelko
Posts: 5
Joined: Tue May 14, 2013 11:30 am

Re: Excel VBA for IOWarrior and Sensirion SHT7x

Post by jmmelko »

Hello Christof,

thanks for the code, but I don't understand the HEX sequences you're sending. Also, why do you have to repeat some sequences (such as HC00101)?

Can you "translate" them into USB HID Reports (should be 8 bytes long)?

They do no seem to correspond any of the sequences listed in the IOWarrior datasheet.

Is the IOW warrior included in the dongle (IOW158A-S) so different from the IOWarrior24?

Thank you.
Guido Körber
Site Admin
Posts: 2856
Joined: Tue Nov 25, 2003 10:25 pm
Location: Germany/Berlin
Contact:

Re: Excel VBA for IOWarrior and Sensirion SHT7x

Post by Guido Körber »

No, IOW158A and IOW24 are almost identical, the main difference is that the IOW158A has the pull up resistors on the I2C lines off after reset.

The WriteHex function seems to do the padding to 8 bytes. And the values written to the IO-Warrior are backwards in the function calls, so "HC00101" is actually $01, $01, $C0 padded with zeros. This enables the Sensibus function with pullups disabled. Why it is written twice is unknown to me, this is definitely not necessary.
jmmelko
Posts: 5
Joined: Tue May 14, 2013 11:30 am

Re: Excel VBA for IOWarrior and Sensirion SHT7x

Post by jmmelko »

Thank you !

In the meantime I succeeded in understanding the hex sequences, I am posting the results below for future reference. Indeed, the repetition of &HC00101 seems unnecessary. I also think that the 70203 sequence is unnecessary.

Do you know why for sequence "30303" he chose to read off 3 bytes (count=3) after sending the command?
* Is it for memory allocation? In tbis case shouldn't it be 4 instead? (1 ReportID + 1 flags + 2 data bytes)
* Or has it something to do with what is asked in the datasheet that "After issuing a measurement command the controller has to wait for the measurement to complete." ?


Thank you.

List of used HEX sequences:

Code: Select all

	   ReportID     1     2          3     4      5      6      7		
C00101     01     01     11000000   00    00     00     00     00		IIC enable, pull ups disabled
70203      03     02     111        00	 00     00     00     00		Read status register
68202      02     82     110        00	 00     00     00     00		Generate start, data count=1 byte
30303      03     03     11         00	 00     00     00     00		Measure temperature, read off 3 bytes (wait?)
50303      03     03     101        00	 00     00     00     00		Measure humidity, read off 3 bytes (wait?)
The $02 value in the read status register hex sequence might be to "get rid" of 2 bytes transmitted by the sensor after the command is issued (status register and checksum?)
Last edited by jmmelko on Fri May 17, 2013 5:36 pm, edited 1 time in total.
jmmelko
Posts: 5
Joined: Tue May 14, 2013 11:30 am

Re: Excel VBA for IOWarrior and Sensirion SHT7x

Post by jmmelko »

I should add that the IOWarrior USB dongle power ups the sensor with a VDD=3.3V voltage (which is the optimum with respect to device calibration, according to Sensirion's datasheet). Hence a temperature coefficient of -39.66 should be used instead of -40.1 as written in Christof's code.

Also, I don't quite understand the "Swap" function.
I understand that a Big-Endian to Little-Endian conversion has to be made because Sensirion transmits the MSB first (big endian) while the x86 processor stores the LSB first (little endian).

However, temperature is measured with a 14bit resolution and thus is stored into 2 bytes. The third byte is the CRC checksum. For a 8bit resolution (i.e. for a faster acquisition) the first byte would not used.
The USB report sent by the IOWarrior microcontroller is thus composed of: ReportID(0)=3, flags(1), MSB(2), LSB(3), Checksum(4), and 3 zero bytes. Hence I would have expected the Swap function to be :

Code: Select all

Swap = S(2) * 256 + S(3) 
It makes sense because such a number has only 4 significative digits, which is consistent with what is displayed by the USB Sensor Viewer supplied by Sensirion. A 3 bytes number would have 9 digits.

Am I correct?
jmmelko
Posts: 5
Joined: Tue May 14, 2013 11:30 am

Re: Excel VBA for IOWarrior and Sensirion SHT7x

Post by jmmelko »

I am posting here a modified (improved?) version of Christof's code).

If someone knows how to read or write the status register of the SHT75 sensor I would be very grateful!!!

I don't get if I need to send a write IIC or read IIC command for that.

Thank you.

Code: Select all


Option Explicit

Public Const IOW_PIPE_IO_PINS As Integer = 0
Public Const IOW_PIPE_SPECIAL_MODE As Integer = 1
Public Const IOWKIT24_IO_REPORT_SIZE As Integer = 8


Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' IO-Warrior low-level library API functions
Public Declare Function IowKitOpenDevice Lib "iowkit" () As Long
Public Declare Sub IowKitCloseDevice Lib "iowkit" (ByVal iowHandle As Long)
Public Declare Function IowKitWrite Lib "iowkit" (ByVal iowHandle As Long, ByVal numPipe As Long, ByRef buffer As Byte, ByVal length As Integer) As Long
Public Declare Function IowKitRead Lib "iowkit" (ByVal iowHandle As Long, ByVal numPipe As Long, ByRef buffer As Byte, ByVal length As Integer) As Long


' Get number of IOW devices
Public Declare Function IowKitGetNumDevs Lib "iowkit" () As Long

' Get Nth IOW device handle
Public Declare Function IowKitGetDeviceHandle Lib "iowkit" (ByVal numDevice As Long) As Long
Public Declare Function IowKitGetProductId Lib "iowkit" (ByVal iowHandle As Long) As Long
Public Declare Function IowKitGetSerialNumber Lib "iowkit" (ByVal iowHandle As Long, ByRef SerialNumber As Byte) As Long


Private Function MyRead(iowHandle As Long)
    Dim res As Long, S(IOWKIT24_IO_REPORT_SIZE) As Byte
    Do
        res = IowKitRead(iowHandle, IOW_PIPE_SPECIAL_MODE, S(0), IOWKIT24_IO_REPORT_SIZE)
    Loop Until res >= IOWKIT24_IO_REPORT_SIZE
    MyRead = EndianSwap(S)
End Function

' Big-Endian (Sensirion) to Little-Endian (x86 processor) conversion
Private Function EndianSwap(S() As Byte)
    EndianSwap = S(2) * 256 + S(3)
End Function

Public Function mySetup(iowHandle As Long)
    Dim res As Long
    Dim Report(IOWKIT24_IO_REPORT_SIZE) As Byte

    'If a 3.3V slave is to be connected the internal pull up resistors of the IOW24 should be switched off by software on enabling the I2C function.
    ' Activate IIC
    Report(0) = &H1 'IIC Special Mode (to be sent to pipe 1)
    Report(1) = &H1 'Disable pull-ups
    Report(2) = &HC0 'Use Sensibus protocol for SHT75
    Report(3) = &H0 'Default timeout
    Report(4) = &H0
    Report(5) = &H0
    Report(6) = &H0
    Report(7) = &H0

    res = IowKitWrite(iowHandle, IOW_PIPE_SPECIAL_MODE, Report(0), IOWKIT24_IO_REPORT_SIZE)
    If res <> IOWKIT24_IO_REPORT_SIZE Then MsgBox ("IIC Activation failed")
    mySetup = res
End Function

Public Function mySoftReset(iowHandle As Long)
    Dim res As Long
    Dim Report(IOWKIT24_IO_REPORT_SIZE) As Byte
  
    ' Soft reset
    Report(0) = &H3 'Read IIC start
    Report(1) = &H4 'Number of read bytes
    Report(2) = &H1E 'Soft reset command
    Report(3) = &H0
    Report(4) = &H0
    Report(5) = &H0
    Report(6) = &H0
    Report(7) = &H0

    res = IowKitWrite(iowHandle, IOW_PIPE_SPECIAL_MODE, Report(0), IOWKIT24_IO_REPORT_SIZE)
    If res <> IOWKIT24_IO_REPORT_SIZE Then MsgBox ("Soft reset failed")
    mySoftReset = res
End Function

Public Function myGetTemperature(iowHandle As Long) As Double
    Dim res As Long, temperature As Double
    Dim Report(IOWKIT24_IO_REPORT_SIZE) As Byte

    ' Asks for temperature measurement
    Report(0) = &H3 'Read IIC
    Report(1) = &H4 'Number of read bytes
    Report(2) = &H3 'Command 11 in hex
    Report(3) = &H0 '
    Report(4) = &H0 '
    Report(5) = &H0 '
    Report(6) = &H0 '
    Report(7) = &H0 '

    res = IowKitWrite(iowHandle, IOW_PIPE_SPECIAL_MODE, Report(0), IOWKIT24_IO_REPORT_SIZE)
    If res <> IOWKIT24_IO_REPORT_SIZE Then MsgBox ("Read Temperature Command failed")

    temperature = MyRead(iowHandle)
    myGetTemperature = -39.66 + (0.01 * temperature)  'For 3.3V VDD
    'myGetTemperature = temperature ' Debug only
End Function

Public Function myGetHumidity(iowHandle As Long, temperature As Double) As Double
    Dim res As Long, RHO As Double, RH As Double
    Dim Report(IOWKIT24_IO_REPORT_SIZE) As Byte

    If temperature > 0 Then
        ' Asks for humidity measurement
        Report(0) = &H3 'ReportID
        Report(1) = &H4 'Number of read bytes
        Report(2) = &H5 'Command 101 in hex
        Report(3) = &H0 '
        Report(4) = &H0 '
        Report(5) = &H0 '
        Report(6) = &H0 '
        Report(7) = &H0 '
    
        res = IowKitWrite(iowHandle, IOW_PIPE_SPECIAL_MODE, Report(0), IOWKIT24_IO_REPORT_SIZE)
        If res <> IOWKIT24_IO_REPORT_SIZE Then MsgBox ("Read Humidity Command failed")
    
        RHO = MyRead(iowHandle)
        RH = -2.0468 + 0.0367 * RHO + (-1.5955 * 10 ^ -6 * RHO ^ 2)
        myGetHumidity = (temperature - 25) * (0.01 + 0.00008 * RHO) + RH
    End If
End Function


Sub sensirion()

Dim iowHandles(10) As Long
Dim SerialNumber(18) As Byte
Dim numIOWs, i, j As Integer
Dim res As Long
Dim tempstr As String
Dim temperature As Double
Dim firstdatarow, loopnum As Integer
Dim sampletime As Double

firstdatarow = 10
loopnum = 5
sampletime = 2 'seconds

iowHandles(0) = IowKitOpenDevice() ' Opens first device

If iowHandles(0) > 0 Then

numIOWs = IowKitGetNumDevs()

' Aknowledges IOWarrior USB dongles
For i = 1 To numIOWs
        iowHandles(i - 1) = IowKitGetDeviceHandle(i)
        Cells(i + 1, 1).value = iowHandles(i - 1)
        Cells(i + 1, 2).value = IowKitGetProductId(iowHandles(i - 1))
        res = IowKitGetSerialNumber(iowHandles(i - 1), SerialNumber(0))
        
        tempstr = ""
        For j = 1 To 16
             tempstr = tempstr & StrConv(SerialNumber(j), 1)
             Cells(i + 1, 3).value = tempstr
        Next j
Next i

res = mySetup(iowHandles(0))

If res <> 0 Then
    For i = 1 To loopnum
        temperature = myGetTemperature(iowHandles(0))
        Cells(firstdatarow + i - 1, 1).value = temperature
        Cells(firstdatarow + i - 1, 2).value = myGetHumidity(iowHandles(0), temperature)
        Sleep (sampletime * 1000)
    Next i
End If

IowKitCloseDevice (iowHandles(0))

Else
    MsgBox ("No USB Dongle found.")

End If

End Sub





jmmelkon
Posts: 9
Joined: Tue Nov 30, 2021 5:33 pm

Re: Excel VBA for IOWarrior and Sensirion SHT7x

Post by jmmelkon »

Last version of the code.

The registers and the CRC checksum are not handled.

Note that SHT75 is not I²C compliant so the code cannot be transposed as is for other sensors.

Code: Select all

Option Explicit

Public Const IOW_PIPE_IO_PINS As Integer = 0
Public Const IOW_PIPE_SPECIAL_MODE As Integer = 1
Public Const IOWKIT24_IO_REPORT_SIZE As Integer = 8
Public Const FIRST_DATA_ROW As Integer = 10 'Line number to start writing results at
Public Const DEBUG_MODE As Boolean = False

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


' IO-Warrior low-level library API functions
Public Declare Function IowKitOpenDevice Lib "C:\Users\Administrateur\Desktop\sensirion\iowkit.dll" () As Long
Public Declare Sub IowKitCloseDevice Lib "C:\Users\Administrateur\Desktop\sensirion\iowkit.dll" (ByVal iowHandle As Long)
Public Declare Function IowKitWrite Lib "C:\Users\Administrateur\Desktop\sensirion\iowkit.dll" (ByVal iowHandle As Long, ByVal numPipe As Long, ByRef buffer As Byte, ByVal length As Integer) As Long
Public Declare Function IowKitRead Lib "C:\Users\Administrateur\Desktop\sensirion\iowkit.dll" (ByVal iowHandle As Long, ByVal numPipe As Long, ByRef buffer As Byte, ByVal length As Integer) As Long
'Public Declare Function IowKitReadNonBlocking Lib "iowkit" (ByVal iowHandle As Long, ByVal numPipe As Long, ByRef buffer As Eight, ByVal length As Long) As Long
'Public Declare Function IowKitReadImmediate Lib "iowkit" (ByVal iowHandle As Long, ByRef value As Long) As Long


' Get number of IOW devices
Public Declare Function IowKitGetNumDevs Lib "C:\Users\Administrateur\Desktop\sensirion\iowkit.dll" () As Long

' Get Nth IOW device handle
Public Declare Function IowKitGetDeviceHandle Lib "C:\Users\Administrateur\Desktop\sensirion\iowkit.dll" (ByVal numDevice As Long) As Long
'Public Declare Function IowKitSetLegacyOpenMode Lib "iowkit" (ByVal openMode As Long) As Long
Public Declare Function IowKitGetProductId Lib "C:\Users\Administrateur\Desktop\sensirion\iowkit.dll" (ByVal iowHandle As Long) As Long
'Public Declare Function IowKitGetRevision Lib "iowkit" (ByVal iowHandle As Long) As Long
'Public Declare Function IowKitGetThreadHandle Lib "iowkit" (ByVal iowHandle As Long) As Long
Public Declare Function IowKitGetSerialNumber Lib "C:\Users\Administrateur\Desktop\sensirion\iowkit.dll" (ByVal iowHandle As Long, ByRef SerialNumber As Byte) As Long
'Public Declare Function IowKitSetTimeout Lib "iowkit" (ByVal iowHandle As Long, ByVal TimeOut As Long) As Long
'Public Declare Function IowKitSetWriteTimeout Lib "iowkit" (ByVal iowHandle As Long, ByVal TimeOut As Long) As Long
'Public Declare Function IowKitCancelIo Lib "iowkit" (ByVal iowHandle As Long, ByVal numPipe As Long) As Long
'Public Declare Function GetTickCount Lib "kernel32" () As Long


Private Function SensorByteRead(iowHandle As Long, ByRef S() As Byte)
    Dim i As Integer, bytesRead As Integer
    i = 1
    Do
        bytesRead = IowKitRead(iowHandle, IOW_PIPE_SPECIAL_MODE, S(0), IOWKIT24_IO_REPORT_SIZE)
        i = i + 1
    Loop Until (bytesRead >= IOWKIT24_IO_REPORT_SIZE) Or (i = 20)
    SensorByteRead = bytesRead
End Function

Private Function SensorRead(iowHandle As Long)
    Dim S(IOWKIT24_IO_REPORT_SIZE) As Byte, bytesRead As Integer
    bytesRead = SensorByteRead(iowHandle, S)
    SensorRead = EndianSwap(S)
End Function

' Big-Endian (Sensirion) to Little-Endian (x86 processor) conversion
Private Function EndianSwap(S() As Byte)
    EndianSwap = S(2) * 256 + S(3)
End Function

Public Function SensorSetup(iowHandle As Long)
    Dim res As Long
    Dim Report(IOWKIT24_IO_REPORT_SIZE) As Byte

    'If a 3.3V slave is to be connected the internal pull up resistors of the IOW24 should be switched off by software on enabling the I2C function.
    ' Activate IIC
    Report(0) = &H1 'IIC Special Mode (to be sent to pipe 1)
    Report(1) = &H1 'Enable I2C
    Report(2) = &HC0 'Disable pull-ups + Use Sensibus protocol for SHT75
    Report(3) = &H0 'Default timeout
    Report(4) = &H0
    Report(5) = &H0
    Report(6) = &H0
    Report(7) = &H0

    res = IowKitWrite(iowHandle, IOW_PIPE_SPECIAL_MODE, Report(0), IOWKIT24_IO_REPORT_SIZE)
    If res <> IOWKIT24_IO_REPORT_SIZE Then MsgBox ("IIC Activation failed")
    SensorSetup = res
End Function

Public Function SoftReset(iowHandle As Long)
    Dim res As Long
    Dim Report(IOWKIT24_IO_REPORT_SIZE) As Byte
  
    ' Soft reset
    Report(0) = &H3 'Read IIC start
    Report(1) = &H3 'Number of read bytes
    Report(2) = &H1E 'Soft reset command
    Report(3) = &H0
    Report(4) = &H0
    Report(5) = &H0
    Report(6) = &H0
    Report(7) = &H0

    res = IowKitWrite(iowHandle, IOW_PIPE_SPECIAL_MODE, Report(0), IOWKIT24_IO_REPORT_SIZE)
    If res <> IOWKIT24_IO_REPORT_SIZE Then MsgBox ("Soft reset failed")
    SoftReset = res
End Function

Public Function GetTemperature(iowHandle As Long) As Double
    Dim res As Long, temperature As Double
    Dim Report(IOWKIT24_IO_REPORT_SIZE) As Byte

    ' Asks for temperature measurement
    Report(0) = &H3 'Read IIC
    Report(1) = &H3 'Number of read bytes
    Report(2) = &H3 'Command 11 in hex
    Report(3) = &H0 '
    Report(4) = &H0 '
    Report(5) = &H0 '
    Report(6) = &H0 '
    Report(7) = &H0 '

    res = IowKitWrite(iowHandle, IOW_PIPE_SPECIAL_MODE, Report(0), IOWKIT24_IO_REPORT_SIZE)
    If res <> IOWKIT24_IO_REPORT_SIZE Then MsgBox ("Read Temperature Command failed")

    temperature = SensorRead(iowHandle)
    GetTemperature = -39.66 + (0.01 * temperature)  'For 3.3V VDD
    'myGetTemperature = temperature ' Debug only
End Function


Public Function GetHumidityBytes(iowHandle As Long, temperature As Double, ByRef S() As Byte) As Double
    Dim res As Long
    Dim Report(IOWKIT24_IO_REPORT_SIZE) As Byte

    If temperature > 0 Then
        ' Asks for humidity measurement
        Report(0) = &H3 'ReportID
        Report(1) = &H3 'Number of read bytes
        Report(2) = &H5 'Command 101 in hex
        Report(3) = &H0 '
        Report(4) = &H0 '
        Report(5) = &H0 '
        Report(6) = &H0 '
        Report(7) = &H0 '
    
        res = IowKitWrite(iowHandle, IOW_PIPE_SPECIAL_MODE, Report(0), IOWKIT24_IO_REPORT_SIZE)
        If res <> IOWKIT24_IO_REPORT_SIZE Then MsgBox ("Read Humidity Command failed")
    
        GetHumidityBytes = SensorByteRead(iowHandle, S)
    End If
End Function

Public Function GetHumidity(iowHandle As Long, temperature As Double) As Double
    Dim res As Long, RHO As Double, RH As Double
    Dim S(IOWKIT24_IO_REPORT_SIZE) As Byte

    If temperature > 0 Then
        res = GetHumidityBytes(iowHandle, temperature, S)
        RHO = EndianSwap(S)
        RH = -2.0468 + 0.0367 * RHO + (-1.5955 * 10 ^ -6 * RHO ^ 2)
        GetHumidity = (temperature - 25) * (0.01 + 0.00008 * RHO) + RH
    End If
End Function

Sub sensirion()

Dim iowHandles(10) As Long
Dim SerialNumber(18) As Byte
Dim numIOWs, i, j As Integer
Dim res As Long
Dim tempstr As String
Dim temperature As Double
Dim firstdatarow, loopnum As Integer
Dim loopdelay As Double
Dim RHDEBUG(IOWKIT24_IO_REPORT_SIZE) As Byte

loopnum = Application.Evaluate("loop_num") 'number of times the loop is called
loopdelay = Application.Evaluate("loop_delay") 'seconds

iowHandles(0) = IowKitOpenDevice() ' Opens first device

If iowHandles(0) > 0 Then

    numIOWs = IowKitGetNumDevs()
    
    ' Aknowledges IOWarrior USB dongles
    For i = 1 To numIOWs
            iowHandles(i - 1) = IowKitGetDeviceHandle(i)
            Cells(i + 1, 1).value = iowHandles(i - 1)
            Cells(i + 1, 2).value = IowKitGetProductId(iowHandles(i - 1))
            res = IowKitGetSerialNumber(iowHandles(i - 1), SerialNumber(0))
            
            tempstr = ""
            For j = 1 To 16
                 tempstr = tempstr & StrConv(SerialNumber(j), 1)
                 Cells(i + 1, 3).value = tempstr
            Next j
    Next i
    
    res = SensorSetup(iowHandles(0))
    
    If res <> 0 Then
        For i = 1 To loopnum
            temperature = GetTemperature(iowHandles(0))
            Cells(FIRST_DATA_ROW + i - 1, 1).value = temperature
            Cells(FIRST_DATA_ROW + i - 1, 2).value = GetHumidity(iowHandles(0), temperature)
            
            If DEBUG_MODE Then
                res = GetHumidityBytes(iowHandles(0), temperature, RHDEBUG)
                Cells(FIRST_DATA_ROW + i - 1, 3).value = RHDEBUG(0)
                Cells(FIRST_DATA_ROW + i - 1, 4).value = RHDEBUG(1)
                Cells(FIRST_DATA_ROW + i - 1, 5).value = RHDEBUG(2)
            End If
            
            Sleep (loopdelay * 1000)
        Next i
    End If
    
    IowKitCloseDevice (iowHandles(0))

Else

    MsgBox ("No USB Dongle found.")

End If

End Sub


Guido Körber
Site Admin
Posts: 2856
Joined: Tue Nov 25, 2003 10:25 pm
Location: Germany/Berlin
Contact:

Re: Excel VBA for IOWarrior and Sensirion SHT7x

Post by Guido Körber »

Please keep in mind that this works only with IOW24. IOW24 is a discontinued product. It did run out in 2018.
devonho
Posts: 1
Joined: Thu Jan 27, 2022 9:46 am

Re: Excel VBA for IOWarrior and Sensirion SHT7x

Post by devonho »

I've hacked together some C++/Node.js code based on the very helpful posts here and the IOW SDK samples.
User avatar
Christoph Jung
Posts: 670
Joined: Sun Oct 08, 2006 3:43 pm
Location: Germany / Berlin
Contact:

Re: Excel VBA for IOWarrior and Sensirion SHT7x

Post by Christoph Jung »

Hi. looks great and will help a lot of people.
Based on this maybe I can create some nodes for different sensors if you are OK with this.
Abteilung: Softwareentwicklung
Folge uns auf Twitter
Follow us on twitter
Post Reply