Hello MarylandDIY,
These two macros may help you. I wrote these several years ago so file data could be kept in the workbook and the file restored when needed on the user's system.
Any file can be stored this way because it is copied as a byte array to the worksheet. The bytes are in hexadecimal. This makes it easier to locate problems in a file.
Add a new VBA module to your workbook for these macros.
Private Sub SaveAsHexFile(ByVal Filename As String)
Dim c As Long
Dim DataByte As Byte
Dim Data() As Variant
Dim i As Long
Dim n As Integer
Dim r As Long
Dim Wks As Worksheet
Dim x As String
If Dir(Filename) = "" Then
MsgBox "The File '" & Filename & "' Not Found."
Exit Sub
End If
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
.Columns("A:AF").AutoFit
End With
Application.ScreenUpdating = True
End Sub
Function RestoreHexFile() As String
Dim Cell As Range
Dim Data() As Byte
Dim File As String
Dim j As Long
Dim LSB As Variant
Dim MSB As Variant
Dim n As Integer
Dim Rng As Range
Dim Wks As Worksheet
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 = Environ("TEMP") & "\" & 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
Example
Sub Test()
Dim Filename As String
' Save picture to the worksheet Hex Byte Data.
Filename = "C:\Test\V447114.jpg"
Call SaveAsHexFile(Filename)
' Restore the file to the user's Temp directory.
Filename = RestoreHexFile
' Filename now is the complete file path to the restored file.
' Pass this to another macro or application.
End Sub