Insert Document into word from acces

C

Chintsapete

Registered User.
Local time
Today, 11:01
Joined
Jun 15, 2012
Messages
137
I want to automate employment contracts. In my form in the payroll I fill in all the details and select what department they work in a press a button and it selects the template fills in all the FormText fiels and inserts the document for each department's Job description.
I made word a word document with FormText fields and populate them from access 2007 with code below, which works sweet (I cut some of the code). What doesn't work is to insert another document into the bookmark "txtJobDesc", I always get the error "462: The remote server machine does not exist or is unavailable". I did read hundreds of posts and tried different variations but for some reason I cant come right with this.
Any help appreciated.

Code: 
Private Sub Command188_Click()
Dim appWord As Object
Dim doc As Word.Document
   
 On Error Resume Next
Error.Clear
 Set appWord = GetObject("Word.Application")
 If Error <> 0 Then
     Set appWord = New Word.Application
 End If
 On Error GoTo errHandler
 Set doc = appWord.Documents.Open("C:\Users\Server-new\Documents\Accounting\Payroll\BuccaneersContractPermanent.dotm", , True)
appWord.Visible = True
 
With doc
If IsNull(Me.Titel) Then
.FormFields("txtTitle").Result = ""
Else
.FormFields("txtTitle").Result = Me.Titel.Column(1)
End If
If IsNull(Me.FirstName) Then
.FormFields("txtFirstName").Result = ""
Else
.FormFields("txtFirstName").Result = Me.FirstName
End If

    'Copy and Paste Job description doesn't work

If IsNull(Me.Department) Then
.FormFields("txtJobDesc").Result = ""
ElseIf (Me.Department.Column(1)) = "Bar" Then
        ActiveDocument.Bookmarks("txtJobDesc").Select
        Selection.InsertFile FileName = "C:\Users\Server-new\Documents\Accounting\Payroll\Barman Job Description.docx"
End If

If IsNull(Me.DateOfEngagment) Then
.FormFields("txtDOE").Result = ""
Else
.FormFields("txtDOE").Result = Me.DateOfEngagment
End If

End With
 
 Set doc = Nothing
 Set appWord = Nothing
Exit Sub
errHandler:
 MsgBox Err.Number & ": " & Err.Description

End Sub

Another option I tried (Error code 424: Object required)
Code: 
 'Copy and Paste Job description

If IsNull(Me.Department) Then
.FormFields("txtJobDesc").Result = ""
ElseIf (Me.Department.Column(1)) = "Bar" Then
        Set objWord = CreateObject(“Word.Application”)
        objWord.Visible = True
        Set objDoc = objWord.Documents.Add()
        Set objSelection = objWord.Selection
        objSelection.TypeText "Job description Barman "
        ActiveDocument.FormFields("txtJobDesc").Select
        objSelection.InsertFile = ("C:\Users\Server-new\Documents\Accounting\Payroll\Barman Job Description.docx")


End If
 
You need the reference to the Word document, so put a . in front.
Code: 
        [B][COLOR=Red].[/COLOR][/B]ActiveDocument.Bookmarks("txtJobDesc").Select
        [B][COLOR=Red].[/COLOR][/B]Selection.InsertFile FileName = "C:\Users\Server-new\Documents\Accounting\Payroll\Barman Job Description.docx"
 
Thanks JHB, one step further, it seems though the bookmark in word doesn't accept the procedure. I think I need to find another field to set there which does, but the code runs as far as selecting the bookmark.
 
I did gave up on the above, I could not make it work. I'm sure there is a way, but with my limited knowledge I can't get there. I would have been a nice and flexible solution with a basic contract (not editable) and job description (editable).
I did manage a work around, a contract for each department and call them up by the selection in the form, which works fine too, just not so flexible.
Thanks for the time
 
Chintsapete said:
Thanks JHB, one step further, it seems though the bookmark in word doesn't accept the procedure. I think I need to find another field to set there which does, but the code runs as far as selecting the bookmark.
Click to expand...
I can't quiet follow you here, can you explain what happen/error and also how you would like it to act?
Could you post a sample of your Word document (zip it), and if you change your code, then post it again.
 
Hi JHB

what I did now is below, essentially I made a contract for each department and a contract without Job description for a new department where you can manually copy and paste the description. Depending what department I select now on my form it opens the correct document. So it works.
The beauty about the insert or copy paste or whatever method would work, one could allow a normal user to edit the job description without them being able to change the basic contract, therefore it stays protected.
I'll attache the standard contract to the post, there is the FormText field at position 1.4 I originally tried to copy and paste the job description into. (Or merge) (or insert) all unsuccessfully. The job description is a normal word document (docx). I left the attached document unprotected. The original code posted should have done that, but as said earlier it didn't work.

I hope above makes sense.
Thanks


Code: 
Private Sub Command188_Click()
Dim appWord As Object
Dim doc As Word.Document
   
 On Error Resume Next
Error.Clear
 Set appWord = GetObject("Word.Application")
 If Error <> 0 Then
     Set appWord = New Word.Application
 End If
 On Error GoTo errHandler
 
 If (Me.Department.Column(1)) = "Bar" Then
 Set doc = appWord.Documents.Open("C:\Users\Server-new\Documents\Accounting\Payroll\BuccaneersContractPermanent - Barman.dotm", , True)
 appWord.Visible = True
 ElseIf (Me.Department.Column(1)) = "Cleaning" Then
 Set doc = appWord.Documents.Open("C:\Users\Server-new\Documents\Accounting\Payroll\BuccaneersContractPermanent - Cleaning.dotm", , True)
 appWord.Visible = True
 ElseIf (Me.Department.Column(1)) = "Maintenance" Then
 Set doc = appWord.Documents.Open("C:\Users\Server-new\Documents\Accounting\Payroll\BuccaneersContractPermanent - Maintenance.dotm", , True)
 appWord.Visible = True
 ElseIf (Me.Department.Column(1)) = "Security" Then
 Set doc = appWord.Documents.Open("C:\Users\Server-new\Documents\Accounting\Payroll\BuccaneersContractPermanent - Security.dotm", , True)
 appWord.Visible = True
 ElseIf (Me.Department.Column(1)) = "Reception" Then
 Set doc = appWord.Documents.Open("C:\Users\Server-new\Documents\Accounting\Payroll\BuccaneersContractPermanent - Reception.dotm", , True)
 appWord.Visible = True
 ElseIf (Me.Department.Column(1)) = "Kitchen" Then
 Set doc = appWord.Documents.Open("C:\Users\Server-new\Documents\Accounting\Payroll\BuccaneersContractPermanent - Kitchen.dotm", , True)
 appWord.Visible = True
 ElseIf (Me.Department.Column(1)) = "Laundry" Then
 Set doc = appWord.Documents.Open("C:\Users\Server-new\Documents\Accounting\Payroll\BuccaneersContractPermanent - Laundry.dotm", , True)
 appWord.Visible = True
 Else
 Set doc = appWord.Documents.Open("C:\Users\Server-new\Documents\Accounting\Payroll\BuccaneersContractPermanent.dotm", , True)
 appWord.Visible = True
 MsgBox "There is no contract for this department Copy the Job description into the space provided"
 End If
 

With doc
If IsNull(Me.Titel) Then
.FormFields("txtTitle").Result = ""
Else
.FormFields("txtTitle").Result = Me.Titel.Column(1)
End If
If IsNull(Me.FirstName) Then
.FormFields("txtFirstName").Result = ""
Else
.FormFields("txtFirstName").Result = Me.FirstName
End If
If IsNull(Me.MiddleName) Then
.FormFields("txtMiddleName").Result = ""
Else
.FormFields("txtMiddleName").Result = Me.MiddleName
End If
If IsNull(Me.LastName) Then
.FormFields("txtLastName").Result = ""
Else
.FormFields("txtLastName").Result = Me.LastName
End If
If IsNull(Me.IDNo) Then
.FormFields("txtId").Result = ""
Else
.FormFields("txtId").Result = Me.IDNo
End If
If IsNull(Me.AddressStreet) Then
.FormFields("txtAddressStreet").Result = ""
Else
.FormFields("txtAddressStreet").Result = Me.AddressStreet
End If
If IsNull(Me.AddressTown) Then
.FormFields("txtAddressTown").Result = ""
Else
.FormFields("txtAddressTown").Result = Me.AddressTown
End If
If IsNull(Me.ZipCode) Then
.FormFields("txtZip").Result = ""
Else
.FormFields("txtZip").Result = Me.ZipCode
End If
If IsNull(Me.BankName) Then
.FormFields("txtBankName").Result = ""
Else
.FormFields("txtBankName").Result = Me.BankName
End If
If IsNull(Me.BranchCode) Then
.FormFields("txtBranchCode").Result = ""
Else
.FormFields("txtBranchCode").Result = Me.BranchCode
End If
If IsNull(Me.AccountNo) Then
.FormFields("txtAccNO").Result = ""
Else
.FormFields("txtAccNO").Result = Me.AccountNo
End If
If IsNull(Me.Branch) Then
.FormFields("txtBranchName").Result = ""
Else
.FormFields("txtBranchName").Result = Me.Branch
End If
If IsNull(Me.AccountType) Then
.FormFields("txtAccType").Result = ""
Else
.FormFields("txtAccType").Result = Me.AccountType.Column(1)
End If
If IsNull(Me.Department) Then
.FormFields("txtDepartm").Result = ""
Else
.FormFields("txtDepartm").Result = Me.Department.Column(1)
End If
If IsNull(Me.DateOfEngagment) Then
.FormFields("txtDOE").Result = ""
Else
.FormFields("txtDOE").Result = Me.DateOfEngagment
End If
If IsNull(Me.DaysWork_week) Then
.FormFields("txtDaysWeek").Result = ""
Else
.FormFields("txtDaysWeek").Result = Me.DaysWork_week
End If
If IsNull(Me.DaysWork_week) Then
.FormFields("txtDaysWeek1").Result = ""
Else
.FormFields("txtDaysWeek1").Result = Me.DaysWork_week
End If
If IsNull(Me.DaysWork_week) Then
.FormFields("txtDaysWeek2").Result = ""
Else
.FormFields("txtDaysWeek2").Result = Me.DaysWork_week
End If
If IsNull(Me.DailyWage) Then
.FormFields("txtDailyWage").Result = ""
Else
.FormFields("txtDailyWage").Result = Format(Me.DailyWage, "R0.00")
End If
If IsNull(Me.PayPeriod) Then
.FormFields("txtPaycycle").Result = ""
Else
.FormFields("txtPaycycle").Result = Me.PayPeriod.Column(1)
End If
If IsNull(Me.PayPeriod) Then
.FormFields("txtPmt").Result = ""
Else
.FormFields("txtPmt").Result = Left(Me.PayPeriod.Column(1), Len(Me.PayPeriod.Column(1)) - 2) 'converts Weekly to week or monthly to month
End If
If IsNull(Me.PayPeriod) Then
.FormFields("txtPayday").Result = ""
ElseIf (Me.PayPeriod) = 2 Then
.FormFields("txtPayDay").Result = "on the Friday"
ElseIf (Me.PayPeriod) = 4 Then
.FormFields("txtPayDay").Result = "on the last Thursday of the month"
End If
If (Me.PensionFundC) = 0 Then
.FormFields("Text1").Result = Format(Me.PensionFundC, "Currency")
ElseIf (Me.PensionFundC) > 0 And (Me.PayPeriod) = 2 Then
.FormFields("Text1").Result = Round(Format(Me.PensionFundC * 52 / 12, "Currency"))
ElseIf (Me.PensionFundC) > 0 And (Me.PayPeriod) = 4 Then
.FormFields("Text1").Result = Format(Me.PensionFundC, "Currency")
End If
If IsNull(Me.FirstName) Then
.FormFields("txtFirstName1").Result = ""
Else
.FormFields("txtFirstName1").Result = Me.FirstName
End If
If IsNull(Me.MiddleName) Then
.FormFields("txtMiddleName1").Result = ""
Else
.FormFields("txtMiddleName1").Result = Me.MiddleName
End If
If IsNull(Me.LastName) Then
.FormFields("txtLastName1").Result = ""
Else
.FormFields("txtLastName1").Result = Me.LastName
End If
End With
 
 Set doc = Nothing
 Set appWord = Nothing
Exit Sub
errHandler:
 MsgBox Err.Number & ": " & Err.Description

End Sub

Private Sub Command191_Click()

Dim appWord As Object
Dim doc As Word.Document
   
 On Error Resume Next
Error.Clear
 Set appWord = GetObject("Word.Application")
 If Error <> 0 Then
     Set appWord = New Word.Application
 End If
 On Error GoTo errHandler
 Set doc = appWord.Documents.Open("C:\Users\Server-new\Documents\Accounting\Payroll\Form UI2.7 - Remuneration received by the employee whilst still in employment.dotx", , True)
appWord.Visible = True
 
With doc
If IsNull(Me.FirstName) Then
.FormFields("txtFirstName").Result = ""
Else
.FormFields("txtFirstName").Result = Me.FirstName
End If
If IsNull(Me.MiddleName) Then
.FormFields("txtMiddleName").Result = ""
Else
.FormFields("txtMiddleName").Result = Me.MiddleName
End If
If IsNull(Me.LastName) Then
.FormFields("txtLastName").Result = ""
Else
.FormFields("txtLastName").Result = Me.LastName
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID1").Result = ""
Else
.FormFields("txtID1").Result = Left(Me.IDNo, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID2").Result = ""
Else
.FormFields("txtID2").Result = Mid(Me.IDNo, 2, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID3").Result = ""
Else
.FormFields("txtID3").Result = Mid(Me.IDNo, 3, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID4").Result = ""
Else
.FormFields("txtID4").Result = Mid(Me.IDNo, 4, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID5").Result = ""
Else
.FormFields("txtID5").Result = Mid(Me.IDNo, 5, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID6").Result = ""
Else
.FormFields("txtID6").Result = Mid(Me.IDNo, 6, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID7").Result = ""
Else
.FormFields("txtID7").Result = Mid(Me.IDNo, 7, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID8").Result = ""
Else
.FormFields("txtID8").Result = Mid(Me.IDNo, 8, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID9").Result = ""
Else
.FormFields("txtID9").Result = Mid(Me.IDNo, 9, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID10").Result = ""
Else
.FormFields("txtID10").Result = Mid(Me.IDNo, 10, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID11").Result = ""
Else
.FormFields("txtID11").Result = Mid(Me.IDNo, 1, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID12").Result = ""
Else
.FormFields("txtID12").Result = Mid(Me.IDNo, 12, 1)
End If
If IsNull(Me.IDNo) Then
.FormFields("txtID13").Result = ""
Else
.FormFields("txtID13").Result = Right(Me.IDNo, 1)
End If
If IsNull(Me.DateOfTermination) Then
.FormFields("txtDot").Result = ""
Else
.FormFields("txtDot").Result = Me.DateOfTermination
End If
If IsNull(Me.TerminationReason) Then
.FormFields("txtSick").Result = ""
ElseIf (Me.TerminationReason) = 10 Then
.FormFields("txtSick").Result = "X"
Else
.FormFields("txtSick").Result = ""
End If
If IsNull(Me.TerminationReason) Then
.FormFields("txtMat").Result = ""
ElseIf (Me.TerminationReason) = 9 Then
.FormFields("txtMat").Result = "X"
Else
.FormFields("txtMat").Result = ""
End If
If IsNull(Me.DateOfEngagment) Then
.FormFields("txtFromD").Result = ""
Else
.FormFields("txtFromD").Result = Me.DateOfEngagment
End If
If IsNull(Me.DateOfTermination) Then
.FormFields("txtTod").Result = ""
Else
.FormFields("txtToD").Result = Me.DateOfTermination
End If
If IsNull(Me.DailyWage) Then
.FormFields("txtGros").Result = ""
Else
.FormFields("txtGros").Result = Me.DailyWage * 5 * 52 / 12
End If





End With
 
 Set doc = Nothing
 Set appWord = Nothing
Exit Sub
errHandler:
 MsgBox Err.Number & ": " & Err.Description

End Sub
 

Attachments

The below code find the bookmark and load a document into it.
Code: 
  Dim appWord As Object
  Dim adoc As Word.Document
  
  Set appWord = New Word.Application

 ' Set adoc = appWord.Documents.Open("C:\Users\Server-new\Documents\Accounting\Payroll\BuccaneersContractPermanent.dotm", , True)
  Set adoc = appWord.Documents.Open("C:\Access programmer\ContractPermanentForum.doc")
  appWord.Visible = True
  appWord.ActiveDocument.Bookmarks("txtJobDesc").Select
  appWord.Selection.InsertFile ("C:\Access programmer\Testdoc.doc")
 
Thanks JHB and apologies, for some reason I didn't get an email alert for your post and didn't see it until now, when I wanted to post my solution I came up with, to finish the post.
With your new solution it somehow doesn't fill in the rest of the contract details, but I'm quite sure I might posted to code at the wrong spot in my editor.
The one problem is, I think possibly the bookmarks can't fill in when the template is protected. It's a pity, doesn't work in my solution either, but I think it's good enough as is.
Thank you for your time I do appreciate it. See my solution following and I hope it makes sense to everyone else might needing it.
 
To finish off my post I just wanted to show the solution I came up with and works. The code I posted on the 04-16-2016 had the one thing missing in the word template itself. I came about this post which finally made me understand it.
In the word template I followed the instruction from the link above and put the code below in each template.
Code: 
Private Sub Document_Open()
Selection.GoTo What:=wdGoToBookmark, Name:="txtJobDesc"
Selection.Collapse Direction:=wdCollapseEnd
Selection.InsertFile FileName:="C:\Users\Server-new\Documents\Accounting\Payroll\Job description temp contracts\Job Description - Barman.docx", Link:=True
End Sub

For each Contract template I change the job description path and it updates when I make changes in the job description document without prompt. So all in all it works, the only not so nice thing is I can't protect the template.
I would have tried JHB solution a bit more if I would have seen it earlier and if I didn't come up with this solution. I'm sure it works and I want to say thank you for your time JHB.
 
PMFJI after the party is over, but I wanted to share an example that ships with a book I bought. The book is MS Access 2010 VBA Programing Inside and Out by Andrew Couch.

I used his method of achieving something similar to this and his method is nothing short of pure Genius. Although I have his permission to use the code in my own applications, I do not have his permission to make it available on the internet without his permission.

I highly recommend you invest in this book (I am certain the 2007 version has it as well), the sample code alone is worth the cost of the book...

Ciao!
 
You must log in or register to reply here.

Similar threads

G
How to fix bookmarks in word does not work in win 11 / o365?
Replies
10
Views
1,146
arnelgp
arnelgp
ZKHADI
VBA Code to Module error
Replies
8
Views
906
ZKHADI
ZKHADI
L
Export data from Access to Word with VBA
Replies
12
Views
1,541
arnelgp
arnelgp
A
Export Long Text from Access to Word
Replies
11
Views
2,348
theDBguy
theDBguy
N
Help in having a word doc autofill on opening from access
Replies
3
Views
1,110
Pat Hartman
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom