tatop seems to be done but I thought I would post the update anyway:
Option Explicit
Option Base 1
Sub BinToHex()
Dim ColumnNumber As Long, _
RowNumber As Long, _
Ndx As Long, _
handleNumber As Long, _
InBucket As Variant, _
FileToOpen As String
'get the name of the binary file to open
FileToOpen = Application.GetOpenFilename("Binary files (*.bin),*.bin")
' get the next handle number from windows
handleNumber = FreeFile
'open the file, read into a string
Open FileToOpen For Binary As handleNumber
InBucket = Input(LOF(handleNumber), handleNumber)
Close handleNumber
RowNumber = 1
ColumnNumber = 0
' for each byte of the string, convert to decimal integer value 0 - 256,
' convert the integer to hex
For Ndx = 1 To Len(InBucket)
ColumnNumber = ColumnNumber + 1
Cells(RowNumber, ColumnNumber) = Hex(Asc(Mid(InBucket, Ndx, 1)))
If (Ndx Mod 16) = 0 Then
RowNumber = RowNumber + 1
ColumnNumber = 0
End If
Next Ndx
End Sub
Sub SaveAsBinary()
Dim LastRow As Long, _
RowNdx As Long, _
ColNdx As Long, _
FileNum As Long, _
t0 As Double, _
FName
FName = Application.GetSaveAsFilename
t0 = Timer
LastRow = Cells(Rows.Count, "R").End(xlUp).Row
ReDim outarray(1 To LastRow, 1 To 16)
For RowNdx = 1 To LastRow
For ColNdx = 1 To 16
' convert the cell hex back to decimal and replace with the character string
outarray(RowNdx, ColNdx) = Chr(WorksheetFunction.Hex2Dec(Cells(RowNdx, ColNdx).Value))
Next ColNdx
Next RowNdx
'open the file and save the array
FileNum = FreeFile
Open FName For Binary As FileNum
Put FileNum, , outarray
Close FileNum
Debug.Print "elapsed time ", Timer - t0
End Sub
Bookmarks