Embedded Templates

[MBACON]

Hi folks.
Another question following on from a previous issue that was resolved but without a practical implementation...

Can I embed WORD TEMPLATE into an excel sheet then open it as a normal template (ie., able to make changes).

Everything i have tried so far opens the template file and allows changes but then saves over the original embedded file.

What I would like is the keep the embedded file as a master, un-changeable document.


T_OLE_OB = "5" 'Temporary whilst testing


Set oleObject = ActiveWorkbook.Sheets("Template").OLEObjects(T_OLE_OB) 'How to open as template file and not just edit embedded item and thus overwrite on save??
oleObject.Verb Verb:=xlPrimary


Set WordDocument = oleObject.Object


Call Report_Data.KONSTANT_FIELDS 'Fills in the word documents bookmarks


WordDocument.SaveAs (S_PATH & E_REQ & " - " & E_DESC) 'Saves the file to dedicated point - this works but overrides the


Thanks

[MBACON]

Anyone got any suggestions?

[Artik]

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 SubArtik

[MBACON]

Thanks Artik.
I tried that but still with no success (even stripped out and tried on a new single point book).
Cheers anyway.
M

[snb]

Why don't you post the file (the embedded item included) ?

[MBACON]

Good Point. Attached

[snb]

Sub M_snb()
Sheet1.OLEObjects(1).Verb
With GetObject(, "Word.Application")
.documents(1).SaveAs "G:\OF\embedded", 1
.documents(1).Close 0
End With
End Sub

[Artik]

For my solution, you made a "minor" mistake. You have saved a DOTX file to your workbook, and you want to recover a DOCX file. It's not allowed. What you put in, you have to take it out.
So, first recover the file and then open the document based on this template.
Sub CreateFileFromBytesAndOpenFromTemplate()
'Run this macro whenever you need a new file
Dim wks As Worksheet
Dim strFileFullPath As String
Dim wdApp As Object

Set wks = ThisWorkbook.Worksheets("Embedded File")

strFileFullPath = ThisWorkbook.Path & "\" & "New sample file.dotx"

Call CreateFileFromWks(wks, strFileFullPath)

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")

If wdApp Is Nothing Then
Set wdApp = CreateObject("Word.Application")
End If

If wdApp Is Nothing Then
MsgBox "Something is wrong with your Word application", vbCritical
Exit Sub
End If

With wdApp
'new document based on template
.Documents.Add strFileFullPath ', True
.Visible = True
.Activate
End With

On Error GoTo 0
End Sub

I know the solution presented by snb, but in the past I have had a headache from it many times. But maybe it will work perfectly for you. Much simpler code and less additional actions compared to my solution.

Artik

[MBACON]

Thnak SNB and Artik for that.
I have gone with Artik's solution as the other one just kept overwriting the original embedded file (yes i changed the saveas directory).
Just got to splice it into the rest of my script now.

Thanks.

[snb]

In this case I'd rather use a workspace instead of an embedded file.

[Artik]

Perhaps the snb solution will work. Note that you need to save the "extracted" file (dotx), and only then can you open a new file based on this template. There is no last step in the snb solution.


snb, you can develop your thought because I don't know what's going on?

Artik

[MBACON]

Bit of Background.

I have multiple 'Request types, each with their own template.
The user selects a test type, at which point a user form pops up with the relevant field which they fill in, when submitted the code transfers the data to a worksheet log and then sends it to the word template, generating a working report document.
The issues that I have been having are:
It was working fine having a folder with the .dotx files in, the code was picking the correct one, opening it, populating the bookmarks and then saving it as .docx file without any issues.... until I moved the whole lot out of my local development/test area and onto the network, at which point it stopped working.
After a bit of investigation, I identified it was because how our network is set is that network location files are classed as 'from internet' and therefore prtected view gets turned on which stops the code from opening it. (yes the users can go into each file and trust it, or turn off that protection, but there are potentially >100 people will access it and some/most wouldnt know what to do), so I have been looking for an alternative method of having the template there as an embedded file to do it.

Next bit I'm working on is putting you code in to rest Artik, hopefully i get the open commands write and once transfered to network I dont end up with the same issue.

If anyone has any bright ideas.solution i'm open.

(Workspace??)

Thanks.

[snb]

After a bit of investigation, I identified it was because how our network is set is that network location files are classed as 'from internet' and therefore prtected view gets turned on which stops the code from opening it. (yes the users can go into each file and trust it, or turn off that protection, but there are potentially >100 people will access it and some/most wouldnt know what to do), so I have been looking for an alternative method of having the template there as an embedded file to do it.

What happens if you open a Word-file on the network in VBA with this code ?


Sub M_snb()
with documents.add("..//OF/example.docx")
.saveas2 "G:\OF\report.docx"
for each it controls ' reading all textboxes in the userform into the Word-document.
if typename(it)="TextBox" then .variablls(it.tag)=iif(it.text=""," ",it.text)
next
.fields.update
.close -1
end with
End Sub

PS. I don't like bookmarks, I prefer Documentvariables instead.