Insert word file object at bookmark

[gruntingmonkey]

Hello, I am trying to insert a word file at a bookmark in Word (through Excel VBA) but I cant seem to get it right. It keeps pasting the document contents (badly formatted) where I want to just include a copy of the file.

The line I cant get right is Bolded for ease.

Sub CreateContract()

Dim ConTemp As String
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim AccID As String, Serv As String, clName As String

'''Error Handle
On Error GoTo MyErrorHandler

UserNm = Environ$("Username")
'UserID = Application.UserName
AcNm = Sheets("DataInput").Cells(7, 4).Value
CoE = Sheets("DataInput").Cells(8, 4).Value
Dt = Format(Sheets("DataInput").Cells(9, 4).Value, "yyyy_mm_dd")
'''This is the Contract master template
ConTemp = "C:\Users\" & UserNm & "\The Consultancy\Office Management - Templates\Contract Template.dotx"

SvNm = "JT - " & AcNm & " - " & CoE & " - " & Dt & ""


'''Collects the data from Excel
Workbooks(ThisWorkbook.Name).Activate
AccID = Sheets("DataInput").Cells(7, 4).Value
Serv = Sheets("DataInput").Cells(8, 4).Value
clName = Sheets("DataInput").Cells(10, 4).Value

proposal = Sheets("utilities").Cells(8, 5).Value

    Set wdApp = CreateObject("Word.Application")
'''Opens the template
    Set wdDoc = wdApp.Documents.Open(ConTemp)
   
'''Activates Word
    With wdApp
        .Visible = True
        .Activate
'''Replaces bookmarks in Word with data from Excel
        With wdDoc
            .Bookmarks("AccountID").Range.Text = AccID
            .Bookmarks("ServiceType").Range.Text = Serv
            .Bookmarks("ClientName").Range.Text = clName
            
           
           [B] .Bookmarks("Appendix1").Range.InsertFile Filename:=proposal, Link:=False, Attachment:=True[/B]
            
            .SaveAs2 Filename:="C:\Users\" & UserNm & "\The Consultancy\Sales - Documents\Contracts\" & CoE & "\" & SvNm & ".docx", FileFormat:=Word.WdSaveFormat.wdFormatXMLDocument
            .Close
            
        End With
        
    End With

    wdApp.Quit
    
 MsgBox "Please check through the contract in its entirety. If there are any issues, close the file and change the details in the Excel before recreating contract by starting from Step 1."
 
  Sheets("Utilities").Cells(11, 5).Value = "C:\Users\" & UserNm & "\The Consultancy\Sales - Documents\Contracts\" & CoE & "\" & SvNm & ".docx"
  
    Set wdApp = Nothing
    Set wdDoc = Nothing
    
'''Complete/Incomplete
    Sheets("Utilities").Cells(10, 2).Value = Application.UserName & " " & Now
                Sheets("Utilities").Cells(10, 4).Value = "Complete"

    Exit Sub

MyErrorHandler:
 
 wdApp.Quit SaveChanges:=wdDoNotSaveChanges
                MsgBox "Uh oh - It all went wrong!!! Let Jess know and she will sort it for you....probably....Please tell her the following issue:" & vbNewLine & vbNewLine & Err.Description
 
    Set wdApp = Nothing
    Set wdDoc = Nothing
 
 End Sub

 

[NdNoviceHlp]

Seems like you're missing the ConfirmConversions part. Proposal also must be a string. HTH. Dave

proposal = CSTR(Sheets("utilities").Cells(8, 5).Value)
.Bookmarks("Appendix1").Range.InsertFile(FileName:=proposal, ConfirmConversions:=True, Link:=False, Attachment:=True)

 

[gruntingmonkey]

I'm getting a syntax error on the second line. Any ideas?

If I change it to

.Bookmarks("Appendix1").Range.InsertFile Filename:=proposal, ConfirmConversions:=True, Link:=False, Attachment:=True

It embeds the content from the document which is not what I want as the formatting screws up a lot.

 

[NdNoviceHlp]

maybe...

.Bookmarks("Appendix1").InsertFile Filename:=proposal, ConfirmConversions:=True, Link:=False, Attachment:=True

I just googled "word bookmarks insertfile" … there was no range in there. There was the confirmconversions which U had missed. Maybe it should be false? Dave

 

[gruntingmonkey]

That didnt work either. I also googled word bookmarks insertfile.... I have something that works...ish... but I can only load the document into the word file at the very beginning. I have no idea how to move it to the end. ANy ideas

wdDoc.InlineShapes.AddOLEObject ClassType:=Word.Application, Filename:= _
        proposal _
        , LinkToFile:=False, DisplayAsIcon:=True, IconFileName:= _
        "C:\Windows\system32\packager.dll", IconIndex:=2, IconLabel:="app1"

 

[NdNoviceHlp]

Sorry no ideas other than to contact a moderator and ask that this thread be moved to the general excel discussion and other applications forum. I'm guessing Macropod or others will be able to help U there. Good luck. Dave

 

[Macropod]

Hello, I am trying to insert a word file at a bookmark in Word (through Excel VBA) but I cant seem to get it right. It keeps pasting the document contents (badly formatted) where I want to just include a copy of the file.

That is most likely because the two documents have conflicting Style definitions and/or either or both have overridden those Style definitions with direct formatting. Try:

Sub CreateContract()
Dim wdApp As New Word.Application, wdDoc As Word.Document, wdPropDoc As Word.Document
Dim UserNm As String, ConTemp As String, AccID As String, Dt As String, Serv As String
Dim clName As String, SvNm As String, proposal As String, strDocNm As String

'''Error Handle
On Error GoTo MyErrorHandler

UserNm = Environ$("Username")

'''Collects the data from Excel
With ThisWorkbook
  AccID = .Sheets("DataInput").Cells(7, 4).Value
  Serv = .Sheets("DataInput").Cells(8, 4).Value
  Dt = Format(.Sheets("DataInput").Cells(9, 4).Value, "yyyy_mm_dd")
  clName = .Sheets("DataInput").Cells(10, 4).Value
  proposal = .Sheets("utilities").Cells(8, 5).Value
End With

'''This is the Contract master template
ConTemp = "C:\Users\" & UserNm & "\The Consultancy\Office Management - Templates\Contract Template.dotx"

SvNm = "JT - " & AccID & " - " & Serv & " - " & Dt & ""

'This is the output document name
strDocNm = "C:\Users\" & UserNm & "\The Consultancy\Sales - Documents\Contracts\" & Serv & "\" & SvNm & ".docx"

'''Creates a document from the template
Set wdDoc = wdApp.Documents.Add(ConTemp)
Set wdPropDoc = wdApp.Documents.Open(Filename:=proposal, AddToRecentFiles:=False)
  
'''Replaces bookmarks in Word with data from Excel
With wdDoc
  .Bookmarks("AccountID").Range.Text = AccID
  .Bookmarks("ServiceType").Range.Text = Serv
  .Bookmarks("ClientName").Range.Text = clName
  .Bookmarks("Appendix1").Range.FormattedText = wdPropDoc.Range.FormattedText
  .SaveAs2 Filename:=strDocNm, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
  .Close
End With
wdPropDoc.Close False
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing
    
MsgBox "Please check through the contract in its entirety. If there are any issues, close the file and change the details in the Excel before recreating contract by starting from Step 1."
With ThisWorkbook.Sheets("Utilities")
  .Cells(11, 5).Value = strDocNm
  .Cells(10, 2).Value = Application.UserName & " " & Now
  .Cells(10, 4).Value = "Complete"
End With
Exit Sub

MyErrorHandler:
wdApp.Quit SaveChanges:=wdDoNotSaveChanges
MsgBox "Uh oh - It all went wrong!!! Let Jess know and she will sort it for you....probably....Please tell her the following issue:" & vbNewLine & vbNewLine & Err.Description

Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

Note that I have declared all the variables that are needed and have generally tidied up your code.

 

[gruntingmonkey]

I appreciate you tidying it up. I would have done it when I got everything working. However, this still doesnt do what I need it to. It pastes the actual content of the document into the file which is incorrect.

This line doesnt input the file correctly.

.Bookmarks("Appendix1").Range.FormattedText = wdPropDoc.Range.FormattedText

I did have the following code working but it doesnt appear to work now in your code

 wdDoc.InlineShapes.AddOLEObject ClassType:=Word.Application, Filename:= _
        proposal _
        , LinkToFile:=False, DisplayAsIcon:=True, IconFileName:= _
        "C:\Windows\system32\packager.dll", IconIndex:=2, IconLabel:="Proposal Information"

Any ideas?

 

[gruntingmonkey]

I've now changed it to

With wdDoc

  .Bookmarks("AccountID").Range.Text = AccID
  .Bookmarks("ServiceType").Range.Text = Serv
  .Bookmarks("ClientName").Range.Text = clName
  '.Bookmarks("Appendix1").Range.FormattedText = wdPropDoc.Range.FormattedText
  
  wdDoc.InlineShapes.AddOLEObject ClassType:=Word.Application, Filename:= _
        proposal _
        , LinkToFile:=False, DisplayAsIcon:=True, IconFileName:= _
        "C:\Windows\system32\packager.dll", IconIndex:=2, IconLabel:="Proposal Information"
  
  .SaveAs2 Filename:=strDocNm, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
  .Close
End With

This seems to work but the file is still at the very start of the document as opposed to the very end where I want it!

 

[Macropod]

I thought the issue was the bad formatting; it seems all you want is an embedded object displayed as an icon. In that case, try:

Sub CreateContract()
Dim wdApp As New Word.Application, wdDoc As Word.Document, strDocNm As String
Dim UserNm As String, ConTemp As String, AccID As String, Dt As String
Dim Serv As String, clName As String, SvNm As String, proposal As String

'''Error Handle
On Error GoTo MyErrorHandler

UserNm = Environ$("Username")

'''Collects the data from Excel
With ThisWorkbook
  AccID = .Sheets("DataInput").Cells(7, 4).Value
  Serv = .Sheets("DataInput").Cells(8, 4).Value
  Dt = Format(.Sheets("DataInput").Cells(9, 4).Value, "yyyy_mm_dd")
  clName = .Sheets("DataInput").Cells(10, 4).Value
  proposal = .Sheets("utilities").Cells(8, 5).Value
End With

'''This is the Contract master template
ConTemp = "C:\Users\" & UserNm & "\The Consultancy\Office Management - Templates\Contract Template.dotx"

SvNm = "JT - " & AccID & " - " & Serv & " - " & Dt & ""

'This is the output document name
strDocNm = "C:\Users\" & UserNm & "\The Consultancy\Sales - Documents\Contracts\" & Serv & "\" & SvNm & ".docx"

'''Creates a document from the template
Set wdDoc = wdApp.Documents.Add(ConTemp)
  
'''Replaces bookmarks in Word with data from Excel
With wdDoc
  .Bookmarks("AccountID").Range.Text = AccID
  .Bookmarks("ServiceType").Range.Text = Serv
  .Bookmarks("ClientName").Range.Text = clName
  .InlineShapes.AddOLEObject ClassType:=Word.Application, Filename:=proposal, _
    LinkToFile:=False, DisplayAsIcon:=True, IconFileName:="C:\Windows\system32\packager.dll", _
    IconIndex:=2, IconLabel:="Proposal Information", Range:=.Bookmarks("Appendix1").Range
  .SaveAs2 Filename:=strDocNm, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
  .Close
End With
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing
    
MsgBox "Please check through the contract in its entirety. If there are any issues, close the file and change the details in the Excel before recreating contract by starting from Step 1."
With ThisWorkbook.Sheets("Utilities")
  .Cells(11, 5).Value = strDocNm
  .Cells(10, 2).Value = Application.UserName & " " & Now
  .Cells(10, 4).Value = "Complete"
End With
Exit Sub

MyErrorHandler:
wdApp.Quit SaveChanges:=wdDoNotSaveChanges
MsgBox "Uh oh - It all went wrong!!! Let Jess know and she will sort it for you....probably....Please tell her the following issue:" & vbNewLine & vbNewLine & Err.Description

Set wdDoc = Nothing: Set wdApp = Nothing
End Sub