Consulting

Results 1 to 13 of 13

Thread: Embedded Templates

  1. #1
    VBAX Regular
    Joined
    Feb 2020
    Posts
    19
    Location

    Embedded Templates

    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

  2. #2
    VBAX Regular
    Joined
    Feb 2020
    Posts
    19
    Location
    Anyone got any suggestions?

  3. #3
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    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

  4. #4
    VBAX Regular
    Joined
    Feb 2020
    Posts
    19
    Location
    Thanks Artik.
    I tried that but still with no success (even stripped out and tried on a new single point book).
    Cheers anyway.
    M

  5. #5
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Why don't you post the file (the embedded item included) ?

  6. #6
    VBAX Regular
    Joined
    Feb 2020
    Posts
    19
    Location
    Good Point. Attached
    Attached Files Attached Files

  7. #7
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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

  8. #8
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    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

  9. #9
    VBAX Regular
    Joined
    Feb 2020
    Posts
    19
    Location
    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.

  10. #10
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    In this case I'd rather use a workspace instead of an embedded file.

  11. #11
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    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

  12. #12
    VBAX Regular
    Joined
    Feb 2020
    Posts
    19
    Location
    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.

  13. #13
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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.
    Last edited by snb; 03-25-2020 at 05:55 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •