T3778_Save Restore Files In Hex

https://excel-egy.com/forum/t3778
---------------------------------

Sub Save_Hex_File()
    Dim wks         As Worksheet
    Dim fileName    As String

    Set wks = Worksheets("Hex Byte Data")
    fileName = ThisWorkbook.Path & "\" & wks.Range("AH1").Value

    If Dir(fileName) <> "" Then
        Call SaveAsHexFile(fileName)
        MsgBox "File Saved", 64
    Else
        MsgBox "The File '" & fileName & "' Not Found."
    End If
End Sub

Sub Restore_Hex_File()
    Dim wks         As Worksheet
    Dim fileName    As String

    Set wks = Worksheets("Hex Byte Data")
    fileName = ThisWorkbook.Path & "\" & wks.Range("AH1").Value

    fileName = RestoreHexFile
    MsgBox "File Restored", 64
End Sub

Private Sub SaveAsHexFile(ByVal fileName As String)
    Dim wks         As Worksheet
    Dim data()      As Variant
    Dim x           As String
    Dim dataByte    As Byte
    Dim n           As Integer
    Dim i           As Long
    Dim r           As Long
    Dim c           As Long

    If Dir(fileName) = "" Then Exit Sub

    On Error Resume Next
        Set wks = Worksheets("Hex Byte Data")
        If Err = 9 Then
            Worksheets.Add After:=Worksheets.Count
            Set wks = ActiveSheet
            wks.Name = "Hex Byte Data"
        End If
    On Error GoTo 0

    wks.Cells.ClearContents
    wks.Cells(1, "AH").Value = Dir(fileName)

    n = FreeFile

    Application.ScreenUpdating = False
        Application.ErrorCheckingOptions.NumberAsText = False

        With wks.Columns("A:AF")
            .NumberFormat = "@"
            .Cells.HorizontalAlignment = xlCenter

            Open fileName For Binary Access Read As #n
            ReDim data((LOF(n) - 1) \ 32, 31)

            For i = 0 To LOF(n) - 1
                Get #n, , dataByte
                c = i Mod 32
                r = i \ 32
                x = Hex(dataByte)
                If dataByte < 16 Then x = "0" & x
                data(r, c) = x
            Next i

            Close #n

            wks.Range("A1:AF1").Resize(r + 1, 32).Value = data
        End With
    Application.ScreenUpdating = True
End Sub

Function RestoreHexFile() As String
    Dim wks         As Worksheet
    Dim lsb         As Variant
    Dim msb         As Variant
    Dim cell        As Range
    Dim rng         As Range
    Dim file        As String
    Dim n           As Integer
    Dim data()      As Byte
    Dim j           As Long

    On Error Resume Next
        Set wks = Worksheets("Hex Byte Data")
        If Err <> 0 Then
            MsgBox "The Worksheet 'Hex Byte Data' Is Missing.", vbCritical
            Exit Function
        End If
    On Error GoTo 0

    Set rng = wks.Range("A1").CurrentRegion
    file = wks.Cells(1, "AH").Value

    If file <> "" Then
        n = FreeFile
        file = ThisWorkbook.Path & "\" & file

        Open file For Binary Access Write As #n
        ReDim data(Application.CountA(rng) - 1)

        For Each cell In rng
            If cell = "" Then Exit For

            msb = Left(cell, 1)
            If IsNumeric(msb) Then msb = 16 * msb Else msb = 16 * (Asc(msb) - 55)

            lsb = Right(cell, 1)
            If Not IsNumeric(lsb) Then lsb = (Asc(lsb) - 55) Else lsb = lsb * 1

            data(j) = msb + lsb
            j = j + 1
        Next cell

        Put #n, , data
        Close #n
    End If

    RestoreHexFile = file
End Function