[RESOLVED] C to Excel VBA

[Peter2047]

Hi All,

I want to use VBA to reading files with the following structure.

struct dathdr7 {
    u_short max_recs;	   
    u_short last_rec;	    
    char zeroes[24];
};
struct ctdata7 {
    float date;
    float open;
    float high;
    float low;
    float close;
    float volume;
    float op_int;
};

This is my VBA Code.

Option Explicit
 
Type head1
     max_rec As Integer
     last_rec As Integer
     zeros As String * 24
End Type
 
Type head2
     ndate As Single
     nopen As Single
     nhigh As Single
     nlow As Single
     nclose As Single
     nvolume As Single
     nop_int As Single
End Type
 
Sub test_read()
 
Dim inhandle As Integer
Dim first_rec As head1
Dim other_rec As head2
Dim filenum As Long
Dim out_ptr As Integer
 
out_ptr = 1
filenum = FreeFile()
Open "C:\Documents and Settings\Administrator\Desktop\Project\File.dat" For Binary As #filenum
 
Get #filenum, , first_rec
Sheets("Sheet1").Range("A1").Offset(0, 0) = first_rec.max_rec
Sheets("Sheet1").Range("A1").Offset(0, 1) = first_rec.last_rec
Sheets("Sheet1").Range("A1").Offset(0, 2) = first_rec.zeros
 
While Not EOF(filenum)
 
    Get #filenum, , other_rec
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 0) = other_rec.ndate
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 1) = other_rec.nopen
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 2) = other_rec.nhigh
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 3) = other_rec.nlow
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 4) = other_rec.nclose
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 5) = other_rec.nvolume
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 6) = other_rec.nop_int
    out_ptr = out_ptr + 1
 
Wend
 
Close #filenum
 
End Sub

This problem I am having now is that the first record is OK. But the subsequent records, all read data are corrupted.

Thanks in advance for all the helps.

[Webtest]

Peter:

Is format of a "Float" from C the same format as a "Single" from VBA? If your header is OK but the first "head2" data record is fouled up this may point to the reason.

Can you post a sample data file with only about 3 data records, and a list of the values in the file? (If you post a zip file I won't be able to read it).

(Edit Add)
P.S. You'll also have a problem if one system is using Unicode for the 24 zero field and the other is using Byte ASCII.

[Webtest]

Here is a dump of a file generated by VBA (Excel 2003) with "max_rec" = 32767, "last_rec" = 15, and 1 record where all values = -8.125 (Data Type = Single). Note that the least significant byte is written first, and the most significant byte is written last for each data value.

Here is the Raw Data (hex) dump. Note that there is a trailing pair of "0"s at the end of the file!:

FF	7F
F	0
30	30
30	30
30	30
30	30
30	30
30	30
30	30
30	30
30	30
30	30
30	30
30	30
0	0
2	C1
0	0
2	C1
0	0
2	C1
0	0
2	C1
0	0
2	C1
0	0
2	C1
0	0
2	C1
0	0

Here is your code output to "Sheet1" for this file

32767	15	000000000000000000000000				
-8.125	-8.125	-8.125	-8.125	-8.125	-8.125	-8.125
0	0	0	0	0	0	0

Here are the routines that I used:

Option Explicit

Type head1
     max_rec As Integer    ' 2 Bytes
     last_rec As Integer   ' 2 Bytes
     zeros As String * 24  '24 Bytes
End Type

Type head2
     ndate As Single
     nopen As Single
     nhigh As Single
     nlow As Single
     nclose As Single
     nvolume As Single
     nop_int As Single
End Type

Sub test_read()    'YOUR Routine!

Dim inhandle As Integer
Dim first_rec As head1
Dim other_rec As head2
Dim filenum As Long
Dim out_ptr As Integer

out_ptr = 1
filenum = FreeFile()
Open "C:\JUNK-2.xxx" For Binary As #filenum

Get #filenum, , first_rec
Sheets("Sheet1").Range("A1").Offset(0, 0) = first_rec.max_rec
Sheets("Sheet1").Range("A1").Offset(0, 1) = first_rec.last_rec
Sheets("Sheet1").Range("A1").Offset(0, 2) = first_rec.zeros

While Not EOF(filenum)

    Get #filenum, , other_rec
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 0) = other_rec.ndate
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 1) = other_rec.nopen
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 2) = other_rec.nhigh
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 3) = other_rec.nlow
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 4) = other_rec.nclose
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 5) = other_rec.nvolume
    Sheets("Sheet1").Range("A1").Offset(out_ptr, 6) = other_rec.nop_int
    out_ptr = out_ptr + 1

Wend

Close #filenum

End Sub
'
'This Subroutine gets pairs of bytes as hex numbers in Columns A/B
'This Writes to a Sheet named "File Contents"
Sub Get_Entire_File()
    Dim FontFile As String
    Dim iFileNum As Integer
    Dim aByte(1) As Byte
    Dim aRow As Long
    Dim aSheet As Worksheet
    
    'Set the file spec for the Font File
    FontFile = "C:\JUNK-2.xxx"
    'Set the Display Sheet
    Set aSheet = ActiveWorkbook.Sheets("File Contents")
    
    iFileNum = FreeFile
    On Error GoTo ERR_FOPEN
    Open FontFile For Binary Access Read As #iFileNum
    On Error GoTo 0
    
    aRow = 1
    Do While Not EOF(iFileNum)
        Get #iFileNum, , aByte    'aByte is really a 2-Byte Array!
        aSheet.Cells(aRow, "A").Value = Hex(aByte(0))
        aSheet.Cells(aRow, "B").Value = Hex(aByte(1))
        aRow = aRow + 1
    Loop
    
    Close #iFileNum
    Exit Sub
    
ERR_FOPEN:
MsgBox "File Open Error"
Close #iFileNum
End Sub
'
'Write a Test File - put hex data in Cols A/B and select the data.
'This routine writes the SELECTED data.
Sub PUT_TEST_FILE()
    Dim FontFile As String
    Dim oFileNum As Integer
    Dim aByte(1) As Byte
    Dim aRow As Long
    Dim aSheet As Worksheet
    Dim aRange As Range
    Dim aCell As Range
    
    'Set the file spec for the Font File
    FontFile = "C:\JUNK-2.xxx"
    'Set the Display Sheet
    Set aSheet = ActiveWorkbook.Sheets("File Contents")
    Set aRange = Selection
    
    oFileNum = FreeFile
    On Error GoTo ERR_FOPEN
    Open FontFile For Binary Access Write As #oFileNum
    On Error GoTo 0
    
    For Each aCell In aRange
        'Put a hex byte in columns E/F and G/H and in the file
        aCell.Offset(0, 4).Value = "&H" & CStr(aCell.Value)
        aCell.Offset(0, 6).Value = CByte("&H" & CStr(aCell.Value))
        'This converts the Hex String or number to byte and writes it
        Put #oFileNum, , CByte("&H" & CStr(aCell.Value))
    Next aCell
    
    Close #oFileNum
    Exit Sub
    
ERR_FOPEN:
MsgBox "File Open Error"
Close #oFileNum

End Sub

[Peter2047]

Hello Webtest,
Thank you very much for taking time to help me out.
Sorry. I am still quite confuse about this whole thing. If a number is written in c as float, I will not be able to read it back used VBA single ? Do I need to read in byte and "assemble" them back together again ?

Sorry for asking so many questions.

Thanks in advance.

[Webtest]

Peter:

Asking and answering questions is what this forum is all about! How else are we going to learn this stuff?

If your C file data type "Float" is IEE 754 standard format, you can definitely read it. However, it may not be in the same byte order that VBA reads, and yes, you may have to do some byte swapping. That shouldn't be a big problem! I guarantee you that as a last resort you can at least rewrite a translated file that can definitely be read by VBA. I gave you an example in the middle of my reply that proves that your read routine works fine (for VBA generated data)!

Here is your code output to "Sheet1" for this file

You are definitely reading back directly into the structures you have defined.

As I suggested in my reply, please provide a sample data file with 2 or 3 records and a list of the expected values. OR ... You can dump the file to byte pairs on a sheet (4680 data records MAX) using the subroutine "Get_Entire_File()" that I provided. If you can cut and paste about 42 rows of this output to a posting and the values for the first 2 data records, we can probably figure out what is going on and what you need to do.

[Webtest]

Peter ...

DKenny (here we bow and grovel) has graciously provided us with the conversion API call that we'll need to pound into place to do what you need to do.

EXCEL: How To: Convert Byte Array To Single [RESOLVED]

Right now, we need the dump of your data and the equivalent values so that we can determine what the Byte Format is for your "Float" data type. If the data is in standard IEE format, you're nearly done! (and I have learned some very important stuff in the process!)

[Peter2047]

Hi Webtest,

Here are the input data from record 1 to 6.
max_rec=0, last_rec=6, zeros = 24 zeros.
5/2/2006 2.74000 2.74000 2.70000 2.71000 1,273,000 2
5/3/2006 2.74000 2.74000 2.70000 2.70000 625,000 2
5/4/2006 2.71000 2.71000 2.69000 2.71000 1,468,000 2
5/5/2006 2.71000 2.75000 2.71000 2.72000 868,000 2
5/8/2006 2.75000 2.76000 2.71000 2.71000 1,605,000 2

Here are the hex dump for column A and B using your subroutine Get_Entire_File().

0 0
6 0
0 0
0 0
0 0
0 0
0 0
0 0
0 0
0 0
0 0
0 0
0 0
0 0
B0 74
1 95
29 5C
2F 82
29 5C
2F 82
CD CC
2C 82
A4 70
2D 82
40 65
1B 95
0 0
0 82
B8 74
1 95
29 5C
2F 82
29 5C
2F 82
CD CC
2C 82
CD CC
2C 82
80 96
18 94
0 0
0 82
C0 74
1 95
A4 70
2D 82
A4 70
2D 82
F6 28
2C 82
A4 70
2D 82
0 33
33 95
0 0
0 82
C8 74
1 95
A4 70
2D 82
0 0
30 82
A4 70
2D 82
7B 14
2E 82
0 EA
53 94
0 0
0 82
E0 74
1 95
0 0
30 82
D7 A3
30 82
A4 70
2D 82
A4 70
2D 82
40 EC
43 95
0 0
0 82
0 0

I hope this will help. Thanks in advance.

Regards, Peter

[Webtest]

OK Peter ... A quick analysis says that your data is NOT IEE 754 and that is the problem. It is close though. It will take some bit manipulation to get your data into the proper format. Do you want to do that?

IEE 754 (VBA) 32 Bit Data format
MSb                                 LSb
SEEE EEEE EMMM MMMM MMMM MMMM MMMM MMMM

Where S = Sign (0 = + | 1 = -)
  EEEEEEEE is Exponent Unsigned Byte biased to 127 = 2 exp 0
  MMM..MMM is Mantissa normalized to 1.0 with leading 1 implied (Significand)

'========================================================
Your Format (approximately)
MSb                                 LSb
EEEE EEEE SMMM MMMM MMMM MMMM MMMM MMMM

Where EEEEEEEE is Exponent Unsigned Byte biased to 128 = 2 exp 0
  (PROBABLY!) S = Sign (0 = + | 1 = -)  (you don't have any negative data!)
  MMM..MMM is Mantissa normalized to 0.1 with leading 1 implied (Significand)

So, as you can see, there is some bit manipulation required, but it isn't too bad. We'll need a negative number dumped to prove where the sign bit is located, but once we get that, the sign swap is fairly trivial. Then we just need to adjust the Exponent to match the normalization and bias, but that just changes the MS Byte value by (edit>) 2.

One serious WARNING: I haven't looked at the date value. That format may be very different from the Windows System format!!! If so, a translation will be needed there as well.

Where do we go from here? You're getting a lot more than you bargained for!!! Thank God for Bright People (like DKenny) and the Forum!

[Webtest]

Peter ...

Yes, you'll need to parse the date as well. The format of the Decimal number (Float) in your file appears to be:

CYYMMDD
Where:
C is a Century code ... 0 = 1900, 1 = 2000, etc.
YY - 2 Digit Year
MM - 2 Digit Month
DD - 2 Digit Day

Can you take care of this? The translation from your file "Float" format to VBA "Single" won't take more than 5 lines of code. You're going to have to buy us all a beer ... and one for Declan's horse too! (that big oat oaf doesn't buy beer) Anyway, this is much more fun than working crossword puzzles. Forget Sudoku or Soduko or whatever that junk is.

[Peter2047]

Hi Webtest,

Thank you very much for taking time to help.
Just wondering how to get beer to you and Declan. Maybe PayPal ? I really appreciate it. Will post the Hex dump with negative value to you later.

Regards, Peter

[Webtest]

Don't forget the horse!

Here is the translation Function (assuming my estimate of the location of the Sign Bit is correct). It works on all of the numbers you gave in your example:

'Convert C "Float" format to IEE 754 VBA "Single" format
Function AdjustExponentAndSign(ByRef ByteArray() As Byte)
    Dim aSign As Boolean
    Dim anLSb As Boolean
    
    'Fetch the sign out of the top of Byte 2
    aSign = (ByteArray(2) And 128)
    'Fetch the low order bit out of Byte 3
    anLSb = (ByteArray(3) And 1)
    'Adjust and Shift Exponent right 1 bit (leaves MSb = 0: addition doesn't affect LSb)
    ByteArray(3) = (ByteArray(3) - 2) \ 2
    'Clear out the MSb of Byte 2 (was the Sign Bit?)
    ByteArray(2) = ByteArray(2) And 127
    'Install the LSb of the Exponent in the top of Byte 2
    If anLSb Then ByteArray(2) = ByteArray(2) Or 128
    'Install the sign bit in the top of Byte 3
    If aSign Then ByteArray(3) = ByteArray(3) Or 128

End Function

Here is how you call it. Just put this line before you call the ByteArray To Single function.

    'Translate the "Float" Byte Array to VBA (IEE 754) "Single" format Byte Array
    AdjustExponentAndSign aByte

Give it a try ... you'll have to change the "Float" definitions in your data structures to Type "Byte" and make them arrays (3). If you have problems, post your code and we'll take a look at it. CAVEAT: This is a 'good faith' estimated solution to your problem. If you use it, all bugs belong to you!

Good Programming and Good Learning! This is the most fun I've had in weeks!

[Peter2047]

This is a 'good faith' estimated solution to your problem. If you use it, all bugs belong to you!

Good Programming and Good Learning! This is the most fun I've had in weeks!

Absolutely agree ! Thank you. Will sure give it a try !

[Webtest]

Peter:

There is one hidden bug in the AdjustExponentAndSign function ... when I adjust the Exponent by subtracting 2, I don't make any provisions for an overflow/underflow exception. I think that if you have an extremely small number, it may crash if it doesn't suddenly convert to an extremely BIG number! We're talking something on the order of 6.0e-39. VBA Singles go down below 1.4e-45. You'll have to take care of that one! You can just test the Raw Float Exponent for a value of less than 2, and if it is less than 2, generate an Underflow Error message but do not process the translation. This problem is more significant than it might appear!

(edit>)P.S. Or you can cheat and set the result to zero!

Also, when you dump the NEGATIVE value, also dump a Float value of zero. Zero has to have a special format ... I haven't taken care of that either!

[Peter2047]

Hi Webtest,

I am not too concern about high precision calculation.

Not a "rocket science project."

I am encountering some errors using your code.

I am a crawling amatuer !

I will struggle for another few days.. in the process... I hope to learn something !

Thanks again.

Regards, Peter

[Webtest]

I am encountering some errors using your code.

I will struggle for another few days.. in the process... I hope to learn something !

Of course you'll learn something! You already have! I still consider myself a 'newbie' in many respects. Just post your error and what line it occurred in and we'll give you a hand.

[Dnereb]

As far I I know a Float is a Double in VBA

Edit:
I was blantently wrong as pointed out to me in a PB

A Float = Real = Single

[Peter2047]

Hi Webtest,

I take your Get_Entire_File() subroutine and change Dim aByte(3) Byte.
Also change aSheet.Cells(aRow, "A").Value = AdjustExponentAndSign(aByte).

The program crash here ...
ByteArray(3) = (ByteArray(3) - 2) \ 2

Not sure why !

Regards, Peter

[Peter2047]

Hi Art,

I did many trial and error, and I mod your program and all the numbers match.
I notice there is some rounding issue e.g. 2.76, I get 2.75999975204467.

Here your program that I modified.
'Convert C "Float" format to IEE 754 VBA "Single" format
Function AdjustExponentAndSign(ByRef ByteArray() As Byte)
Dim aSign As Boolean
Dim anLSb As Boolean

'Fetch the sign out of the top of Byte 2
aSign = (ByteArray(2) And 128)

'Fetch the low order bit out of Byte 3
anLSb = (ByteArray(3) And 1)

'Adjust and Shift Exponent right 1 bit (leaves MSb = 0: addition doesn't affect LSb)
'I change from "-2" to "-1" and the error goes away.
ByteArray(3) = (ByteArray(3) - 1) \ 2

'Clear out the MSb of Byte 2 (was the Sign Bit?)
ByteArray(2) = ByteArray(2) And 127

'Install the LSb of the Exponent in the top of Byte 2
If anLSb Then ByteArray(2) = ByteArray(2) Or 128

'Install the sign bit in the top of Byte 3
If aSign Then ByteArray(3) = ByteArray(3) Or 128

'I add this to take care of the problem of always having extra one at ByteArray(0).
If ByteArray(0) > 0 Then ByteArray(0) = ByteArray(0) - 1

End Function

By the way, how do I verified the date is correct.
5/2/2000 = 4A8174AF
5/3/2000 = 4A8174B7
5/4/2000 = 4A8174BF
5/5/2000 = 4A8174C7
5/8/2000 = 4A8174DF

Thanks in advance.

Regards, Peter

[Peter2047]

Hi Art,
Many thanks for you help. I check for ByteArray(3) before doing the 1 or 2 subtraction. The number and date are OK.

Really appreciate your help.

Not sure how I can change this Thread to Resolved status.

Once again, thanks....

Regards, Peter

Option Explicit
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Type Rec
Max_rec As Integer
Last_rec As Integer
Char24 As String * 24
End Type

'
'This Subroutine gets pairs of bytes as hex numbers in Columns A/B
'This Writes to a Sheet named "File Contents"
Sub Get_Entire_File()
Dim FontFile As String
Dim iFileNum As Integer
Dim aByte(3) As Byte
Dim First_Rec As Rec
Dim aRow, bRow, bCol As Long
Dim aSheet As Worksheet

'Set the file spec for the Font File
FontFile = "D:\File.dat"
'Set the Display Sheet
Set aSheet = ActiveWorkbook.Sheets("Sheet1")

iFileNum = FreeFile
On Error GoTo ERR_FOPEN
Open FontFile For Binary Access Read As #iFileNum
On Error GoTo 0

aRow = 1
bRow = 0

Get #iFileNum, , First_Rec

Sheets("Sheet2").Range("A1").Offset(bRow, 0) = First_Rec.Max_rec
Sheets("Sheet2").Range("A1").Offset(bRow, 1) = First_Rec.Last_rec
Sheets("Sheet2").Range("A1").Offset(bRow, 2) = First_Rec.Char24

aSheet.Cells(aRow, "A").Value = First_Rec.Max_rec
aSheet.Cells(aRow, "B").Value = First_Rec.Last_rec
aSheet.Cells(aRow, "C").Value = First_Rec.Char24

bCol = 0
bRow = bRow + 1
aRow = aRow + 1

Do While Not EOF(iFileNum)
Get #iFileNum, , aByte 'aByte is really a 2-Byte Array!
'Translate the "Float" Byte Array to VBA (IEE 754) "Single" format Byte Array
AdjustExponentAndSign aByte
aSheet.Cells(aRow, "A").Value = Hex(aByte(3))
aSheet.Cells(aRow, "B").Value = Hex(aByte(2))
aSheet.Cells(aRow, "C").Value = Hex(aByte(1))
aSheet.Cells(aRow, "D").Value = Hex(aByte(0))
Sheets("Sheet2").Range("A1").Offset(bRow, bCol) = ConvertHEXtoSingle(aByte)
If bCol = 6 Then
bCol = 0
bRow = bRow + 1
Else
bCol = bCol + 1
End If
aRow = aRow + 1
Loop

Close #iFileNum
Exit Sub

ERR_FOPEN:
MsgBox "File Open Error"
Close #iFileNum
End Sub

'Convert C "Float" format to IEE 754 VBA "Single" format
Function AdjustExponentAndSign(ByRef ByteArray() As Byte)
Dim aSign As Boolean
Dim anLSb As Boolean

'Fetch the sign out of the top of Byte 2
aSign = (ByteArray(2) And 128)

'Fetch the low order bit out of Byte 3
anLSb = (ByteArray(3) And 1)

'Adjust and Shift Exponent right 1 bit (leaves MSb = 0: addition doesn't affect LSb)
If ByteArray(3) >= 2 Then
ByteArray(3) = (ByteArray(3) - 2) \ 2
Else
ByteArray(3) = (ByteArray(3) - 1) \ 2
End If
'Clear out the MSb of Byte 2 (was the Sign Bit?)
ByteArray(2) = ByteArray(2) And 127

'Install the LSb of the Exponent in the top of Byte 2
If anLSb Then ByteArray(2) = ByteArray(2) Or 128

'Install the sign bit in the top of Byte 3
If aSign Then ByteArray(3) = ByteArray(3) Or 128

End Function

Function ConvertHEXtoSingle(abBytes() As Byte) As Single

CopyMemory ConvertHEXtoSingle, abBytes(0), 4

End Function