I will suggest a slightly different way to embed the file in your workbook.
Option Explicit
Sub EmbedFileInWks()
'Perform this macro only once to embed the file in the worksheet
Dim Bytes()
Dim wks As Worksheet
Bytes = ByteArrayFromFile("E:\Samples\Sample file.docx")
Set wks = ThisWorkbook.Worksheets.Add
wks.Name = "Embedded File"
wks.Range("A1").Resize(UBound(Bytes), UBound(Bytes, 2)) = Bytes
End Sub
Sub CreateFileFromBytes()
'Run this macro whenever you need a new file
Dim wks As Worksheet
Dim strFileFullPath As String
Set wks = ThisWorkbook.Worksheets("Embedded File")
strFileFullPath = ThisWorkbook.Path & "\" & "New sample file.docx"
Call CreateFileFromWks(wks, strFileFullPath)
End Sub
Function ByteArrayFromFile(strFileFullPath As String) As Variant
Dim Bytes() As Byte
Dim FileNum As Integer
Dim Var() As Variant
Dim vTmp As Variant
Dim i As Long, k As Long
Dim b As Long
Dim lMax As Long
Dim lInt As Long
Dim bMax As Long
FileNum = FreeFile
ReDim Bytes(1 To FileLen(strFileFullPath))
Open strFileFullPath For Binary As #FileNum
Get #FileNum, 1, Bytes
Close FileNum
lMax = 5000 'number of bytes in one cell
bMax = UBound(Bytes)
'calculate how many rows you will need
lInt = Int((bMax) / lMax)
'if the remainder of the division remains, add one more line
If bMax Mod lMax <> 0 Then
lInt = lInt + 1
End If
'+1, because the first line will be the length of the file (number of bytes)
ReDim Var(1 To lInt + 1, 1 To 1)
b = 0
Var(1, 1) = bMax
'rewrite the byte array to the result array
For i = 2 To lInt + 1
ReDim vTmp(1 To lMax)
For k = 1 To lMax
b = b + 1
vTmp(k) = Format(Bytes(b), "000")
If b >= bMax Then Exit For
Next k
vTmp = Join(vTmp, "")
Var(i, 1) = "'" & vTmp
Next i
ByteArrayFromFile = Var
End Function
Private Sub CreateFileFromWks(wks As Worksheet, ByVal strFileFullPath As String)
Dim Bytes() As Byte
Dim FileNum As Integer
Dim Var() As Variant
Dim i As Long, k As Long
Dim vTmp As Variant
Dim iB As Long
Var = wks.Cells(1).CurrentRegion.Value
ReDim Bytes(1 To Var(1, 1))
For i = 2 To UBound(Var)
vTmp = Empty
vTmp = Var(i, 1)
For k = 1 To Len(vTmp) Step 3
iB = iB + 1
Bytes(iB) = CByte(Mid(vTmp, k, 3))
Next k
Next i
FileNum = FreeFile
Open strFileFullPath For Binary As #FileNum
Put #FileNum, 1, Bytes
Close FileNum
End Sub
Artik