PDA

View Full Version : Solved: Reading a binary file into Excel with VBA code?



trpkob
07-03-2012, 05:44 AM
I have a binary file with hexadecimal information stored within it at hexadecimal addresses. I would like to read in the contents of the file into Excel at specific addresses. For instance, if at 0x0000 there was 00, I would want to read that in and at other specific address. So far I have only been able to read in the entire file. The code below is for reading the entire file which takes forever and sometimes freezes Excel; I only want to read in the data at certain addresses. Any suggestions on VBA code that could accomplish this?

Sub Button1_Click()
Dim intFileNum%, bytTemp As Byte, intCellRow
intFileNum = FreeFile
intCellRow = 0
Open "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin" For Binary Access Read As intFileNum
Do While Not EOF(intFileNum)
intCellRow = intCellRow + 1
Get intFileNum, , bytTemp
Cells(intCellRow, 1) = bytTemp
Loop
Close intFileNum
End Sub

snb
07-03-2012, 06:27 AM
Please use code tags around VBA code !

Sub Button1_Click()
Open "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin" For Binary As #1
c01=Input(LOF(1),#1)
close


for j=1 to len(c01)
cells(j,1)=mid(c01,j,1)
Loop
End Sub

trpkob
07-03-2012, 06:49 AM
I get an error of Loop without do. Also could you provide a brief explanation of how to enter the logical addresses desired?

Kenneth Hobs
07-03-2012, 07:08 AM
Can you attach an example binary file? One could probably use Filter to get what you need. Of course if you output it to a scratch sheet, vLookup could be used which would probably be more useful. It just depends on your data and what parts you want to get and when.

trpkob
07-03-2012, 07:12 AM
I have attached a screenshot of the file.

snb
07-03-2012, 08:16 AM
Well, well, well...


Sub Button1_Click()
Open "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin" For Binary As #1
c01=Input(LOF(1),#1)
Close

For j=1 To len(c01)
cells(j,1)=mid(c01,j,1)
Next
End Sub

trpkob
07-03-2012, 08:23 AM
Well, well, well...


Sub Button1_Click()



Open "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin" For Binary As #1

c01=Input(LOF(1),#1)
Close


For j=1 To len(c01)
cells(j,1)=mid(c01,j,1)
Next

End Sub

Could you provide a brief explanation?

Kenneth Hobs
07-03-2012, 09:58 AM
The screen print does not help me help you.

Replace "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin" with the path to your file.

The first part puts the data into a string array.

The 2nd part reads each row which is each line of the file and puts the results into each row of A1 of the current sheet and down.

Be sure to comment out or delete Option Explicit if you use it or Dim each variable.

trpkob
07-05-2012, 07:53 AM
I am unable to get this working, it reads the ASCII code contained at the end of the address and not the binary.

Kenneth Hobs
07-05-2012, 08:42 AM
Sounds like you want a hex editor as shown in your screen print.

I have not played with snb's routine much. Here is my suggestion for your code, mine, and an adaptation of snb's. You might see if ken() helps.

Sub Button1_Click()
Dim intFileNum%, bytTemp As Byte, intCellRow, fn As String

'fn = "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin"
fn = "w:\ken.wpd"
If Dir(fn) = "" Then
MsgBox "File does not exist:" & vbLf & fn, vbCritical, "Macro Ending"
Exit Sub
End If

On Error GoTo EndSub
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

intFileNum = FreeFile
intCellRow = 0
Open fn For Binary Access Read As intFileNum
Do While Not EOF(intFileNum)
intCellRow = intCellRow + 1
Get intFileNum, , bytTemp
Cells(intCellRow, 1) = bytTemp
Loop
Close intFileNum

EndSub:
SpeedOff
End Sub

Sub ken()
Dim fn As String, s As String

'fn = "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin"
fn = "w:\ken.wpd"
If Dir(fn) = "" Then
MsgBox "File does not exist:" & vbLf & fn, vbCritical, "Macro Ending"
Exit Sub
End If

On Error GoTo EndSub
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

s = FileLoad(fn)
Range("A1").Resize(UBound(Split(s, vbLf))).Value = WorksheetFunction.Transpose(Split(s, vbLf))

EndSub:
SpeedOff
End Sub

'Purpose : Returns the contents of a file as a single continuous string
'Inputs : sFileName The path and file name of the file to open and read
'Outputs : The contents of the specified file
'Notes : Usually used for text files, but will load any file type.
'Revisions :

Function FileLoad(ByVal sFileName As String) As String
Dim iFileNum As Integer, lFileLen As Long

On Error GoTo ErrFinish
'Open File
iFileNum = FreeFile
'Read file
Open sFileName For Binary Access Read As #iFileNum
lFileLen = LOF(iFileNum)
'Create output buffer
FileLoad = String(lFileLen, " ")
'Read contents of file
Get iFileNum, 1, FileLoad

ErrFinish:
Close #iFileNum
On Error GoTo 0
End Function


Sub snb()
Dim fn As String, c01 As String, j As Long

'fn = "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin"
fn = "w:\ken.wpd"
If Dir(fn) = "" Then
MsgBox "File does not exist:" & vbLf & fn, vbCritical, "Macro Ending"
Exit Sub
End If

On Error GoTo EndSub
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

Open "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin" For Binary As #1
c01 = Input(LOF(1), #1)
Close

For j = 1 To Len(c01)
Cells(j, 1) = Mid(c01, j, 1)
Next j

EndSub:
SpeedOff
End Sub

trpkob
07-05-2012, 09:52 AM
Thank you very much! I am getting a compile error on the SpeedOn SpeedOff.


Sounds like you want a hex editor as shown in your screen print.

I have not played with snb's routine much. Here is my suggestion for your code, mine, and an adaptation of snb's. You might see if ken() helps.

Sub Button1_Click()
Dim intFileNum%, bytTemp As Byte, intCellRow, fn As String

'fn = "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin"
fn = "w:\ken.wpd"
If Dir(fn) = "" Then
MsgBox "File does not exist:" & vbLf & fn, vbCritical, "Macro Ending"
Exit Sub
End If

On Error GoTo EndSub
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

intFileNum = FreeFile
intCellRow = 0
Open fn For Binary Access Read As intFileNum
Do While Not EOF(intFileNum)
intCellRow = intCellRow + 1
Get intFileNum, , bytTemp
Cells(intCellRow, 1) = bytTemp
Loop
Close intFileNum

EndSub:
SpeedOff
End Sub

Sub ken()
Dim fn As String, s As String

'fn = "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin"
fn = "w:\ken.wpd"
If Dir(fn) = "" Then
MsgBox "File does not exist:" & vbLf & fn, vbCritical, "Macro Ending"
Exit Sub
End If

On Error GoTo EndSub
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

s = FileLoad(fn)
Range("A1").Resize(UBound(Split(s, vbLf))).Value = WorksheetFunction.Transpose(Split(s, vbLf))

EndSub:
SpeedOff
End Sub

'Purpose : Returns the contents of a file as a single continuous string
'Inputs : sFileName The path and file name of the file to open and read
'Outputs : The contents of the specified file
'Notes : Usually used for text files, but will load any file type.
'Revisions :

Function FileLoad(ByVal sFileName As String) As String
Dim iFileNum As Integer, lFileLen As Long

On Error GoTo ErrFinish
'Open File
iFileNum = FreeFile
'Read file
Open sFileName For Binary Access Read As #iFileNum
lFileLen = LOF(iFileNum)
'Create output buffer
FileLoad = String(lFileLen, " ")
'Read contents of file
Get iFileNum, 1, FileLoad

ErrFinish:
Close #iFileNum
On Error GoTo 0
End Function


Sub snb()
Dim fn As String, c01 As String, j As Long

'fn = "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin"
fn = "w:\ken.wpd"
If Dir(fn) = "" Then
MsgBox "File does not exist:" & vbLf & fn, vbCritical, "Macro Ending"
Exit Sub
End If

On Error GoTo EndSub
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

Open "C:\Documents and Settings\uidv3331\Desktop\Automated Logistics\A2C34651101BAAA.bin" For Binary As #1
c01 = Input(LOF(1), #1)
Close

For j = 1 To Len(c01)
Cells(j, 1) = Mid(c01, j, 1)
Next j

EndSub:
SpeedOff
End Sub

trpkob
07-05-2012, 09:59 AM
I was able to fix the compile error, thank you so much once again, I will play with the code to get desired results.


Thank you very much! I am getting a compile error on the SpeedOn SpeedOff.