I will describe my problem as points:
I have an Access database with functions & macros
there is a function to fill data into Word document (it works well)
I am using late binding
the database should be available to users who don't have Microsoft Application so I install Access runtime (it works well except the function of Word didn't work)
the code below works on a machine that has Access Application but doesn't on other machines.
How can I get the code to run in the Access Runtime?
Private Sub Command96_Click()
Dim appWord As Object
Set appWord = CreateObject("Word.Application")
Dim doc As Object
'Set doc = CreateDocument("Word.Document")
'Avoid error 429, when Word isn't open.
On Error Resume Next
Err.Clear
'Set appWord object variable to running instance of Word.
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isn't open, create a new instance of Word.
'Set appWord = New Word.Application
Set appWord = CreateObject("Word.Application")
End If
'Set doc = appWord.Documents.Open("\\ubcdatacenter\Public\UBCIEDatabase\DOC\H_F.docx", , True)
Set doc = appWord.Documents.Open("\\ubcdatacenter\Public\UBCIEDatabase\DOC\H_F.docx")
With doc
.FormFields("BookID").Result = Me!ID
.FormFields("Book_BC_date").Result = Me!date_BC
.FormFields("Book_AH_date").Result = Me!date_AH
.FormFields("Book_AH_date").Result = Me!date_AH
.FormFields("BookTopic").Result = Me!topic
.FormFields("BookProjectName").Result = Me!projectName
.FormFields("BookCompanyName").Result = Me!companyName
.FormFields("BookContent").Range.Text = Me!content
.Visible = True
.Activate
End With
Set doc = Nothing
Set appWord = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
End Sub
Related
I am modifying someone's access database. The person has a button to create a report that fills out a preprinted form on a dot matrix printer. Now he would like to print it out on a laser printer. I suggested creating a Word document and have Access fill it out and then he can print however many copies he needs.
The previous programmer created a really nice way to print preview and print the reports. I want to add a button to print it to Word.
I have created a document with bookmarks.
I have added the button and have added the code as follows:
Private Sub Print_Test_Click()
On Error GoTo Err_Print_Test_Click
'Print customer slip for current customer.
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim SelectNum As Long
'Avoid error 429, when Word isn't open.
On Error Resume Next
Err.Clear
'Set wApp object variable to running instance of Word.
Set wApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isn't open, create a new instance of Word.
Set wApp = New Word.Application
End If
Set dbs = CurrentDb
If Me.OpenArgs = "FromViewContracts" Then
Set wDoc = wApp.Documents.Open("C:\Shafer\Contract.dotx", , True)
SelectNum = Forms![PrintDialog]![ContractNum]
Set rs = dbs.OpenRecordset("SELECT * FROM PRINTContract WHERE ContNum = SelectNum")
Else
Set wDoc = wApp.Documents.Open("C:\Shafer\Invoice.dotx", , True)
SelectNum = Forms![PrintDialog]![InvoiceNum]
Set rs = dbs.OpenRecordset("SELECT * FROM PRINTInvoice WHERE InvNum = SelectNum")
End If
If rs.NoMatch Then
MsgBox "Record not found."
GoTo Exit_Print_Test_Click
Else
MsgBox "Customer name: " & rs!Customers.Name
End If
wApp.Visible = True
wDoc.Bookmarks("CustName").Range.Text = Nz(rs!Customers.Name, "")
wDoc.Bookmarks("CustAddress").Range.Text = Nz(rs!Customers.Address, "")
wDoc.Bookmarks("CustCity").Range.Text = Nz(rs!Customers.City, "")
wDoc.Bookmarks("CustState").Range.Text = Nz(rs!Customers.State, "")
wDoc.Bookmarks("CustZip").Range.Text = Nz(rs!Customers.Zip, "")
wDoc.Bookmarks("Date").Range.Text = Nz(rs!Date, "")
wDoc.Bookmarks("ContNum").Range.Text = Nz(rs!ContNum, "")
If Me.OpenArgs = "FromViewContracts" Then
' Contract bookmarks here
Else
wDoc.Bookmarks("InvNum").Range.Text = Nz(rs!InvNum, "")
wDoc.Bookmarks("SalesPerson").Range.Text = Nz(rs!Salesperson, "")
wDoc.Bookmarks("Terms").Range.Text = Nz(rs!Terms.Name, "")
End If
wApp.Visible = True
rs.Close
rsTable.Close
Set wDoc = Nothing
Set wApp = Nothing
Set rs = Nothing
Set rsTable = Nothing
Exit Sub
Exit_Print_Test_Click:
Exit Sub
Err_Print_Test_Click:
MsgBox Err.Description
Resume Exit_Print_Test_Click
End Sub
Here is the problem: When this runs, all I get is "Record Not Found"
If I display the value of InvNum or ContNum I have a value, lets say 18500. If I display the value of SelectNum, I have a value of 18500. But I cannot get it to work.
If I change SelectNum to 18500 in the Select statement, it works.
Please help.
I wrote code in Access database 2016 contains functions and macros, then I move this file to share with some users that don't have Access Application so, I install Access runtime it works well but I face many problems with reference libraries.
I decided to use late binding (by writing EarlyBinding = 0 in a database property of VBA editor)
and uncheck all references except two (I can't uncheck) and covert
Set appWord = New Word.Application
to
Set appWord = CreateObject(Word.Application)
note 1: I have a function to open Word document from Access form.
note 2: I convert the database extension from .accdb to .accdr
after I made changes in late binding and convert the previous statement no message error (for reference) appears but the function of open Word doesn't work.
is there a tool like Access runtime for Word? so I can't open for this reason?
below the code of this function:
Function fillWordForm()
Dim appWord As Object
Dim doc As Object
Dim path As String
Dim myID As String
On Error Resume Next
Error.Clear
'Set appWord = CreateObject("word.application")
Set appWord = CreateObject(Word.Application)
If Err.Number <> 0 Then
'Set appWord = New Word.Application
'Set appWord = CreateObject(Word.Application)
appWord.Visible = True
End If
'path = Application.CurrentProject.path & "\H_F.docx"
'path = "\\ubcdatacenter\Public\UBCIEDatabase\DOC\H_F.docx"
path = "C:\Users\LENOVO\Desktop\UBC Database\H_F.docx"
If FileExists(path) = False Then
MsgBox "Template File Not Found", vbExclamation, "File Not Found"
Else
Set doc = appWord.Documents.Add(path, , True)
myID = DLookup("ID", "Exports_imports_Table", "[ID] = " & Me.ID)
With doc
.FormFields("BookID").Result = [ID]
.FormFields("Book_BC_date").Result = Me.date_BC
.FormFields("Book_AH_date").Result = Me.date_AH
.FormFields("Book_AH_date").Result = Me.date_AH
.FormFields("BookTopic").Result = Me.topic
.FormFields("BookProjectName").Result = Me.projectName
.FormFields("BookCompanyName").Result = Me.companyName
.FormFields("BookContent").Range.Text = Me.content
'Result = Me.content
appWord.Visible = True
appWord.Active
End With
Set doc = Nothing
Set appWord = Nothing
End If
End Function
this code to ensure that file is excite
Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
'Purpose: Return True if the file exists, even if it is hidden.
'Arguments: strFile: File name to look for. Current directory searched if no path included.
' bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
'Note: Does not look inside subdirectories for the file.
'Author: Allen Browne. http://allenbrowne.com June, 2006.
Dim lngAttributes As Long
'Include read-only files, hidden files, system files.
lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)
If bFindFolders Then
lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
Else
'Strip any trailing slash, so Dir does not look inside the folder.
Do While Right$(strFile, 1) = "\"
strFile = Left$(strFile, Len(strFile) - 1)
Loop
End If
'If Dir() returns something, the file exists.
On Error Resume Next
FileExists = (Len(Dir(strFile, lngAttributes)) > 0)
End Function
what should also convert to make all code late binding?
Editing
after Mathieu's changes
Function fillWordForm()
Dim appWord As Object
Dim doc As Object
Dim path As String
Dim myID As String
On Error Resume Next
Error.Clear
Set appWord = GetWordApp
If appWord Is Nothing Then
'can't get ahold of Word.Application... now what?
MsgBox "No thing :(((((((((((((("
'Exit Sub
End If
appWord.Visible = True '<~ unconditional
'Set appWord = CreateObject("word.application")
'Set appWord = CreateObject(Word.Application)
'If Err.Number <> 0 Then
'Set appWord = New Word.Application
'Set appWord = CreateObject(Word.Application)
'appWord.Visible = True
'End If
'path = Application.CurrentProject.path & "\H_F.docx"
path = "\\ubcdatacenter\Public\UBCIEDatabase\DOC\H_F.docx"
'path = "C:\Users\LENOVO\Desktop\UBC Database\H_F.docx"
If FileExists(path) = False Then
MsgBox "Template File Not Found", vbExclamation, "File Not Found"
Else
Set doc = appWord.Documents.Add(path, , True)
myID = DLookup("ID", "Exports_imports_Table", "[ID] = " & Me.ID)
With doc
.FormFields("BookID").Result = [ID]
.FormFields("Book_BC_date").Result = Me.date_BC
.FormFields("Book_AH_date").Result = Me.date_AH
.FormFields("Book_AH_date").Result = Me.date_AH
.FormFields("BookTopic").Result = Me.topic
.FormFields("BookProjectName").Result = Me.projectName
.FormFields("BookCompanyName").Result = Me.companyName
.FormFields("BookContent").Range.Text = Me.content
'Result = Me.content
appWord.Visible = True
appWord.Active
End With
Set doc = Nothing
Set appWord = Nothing
End If
End Function
Private Function GetWordApp() As Object
On Error Resume Next
Set GetWordApp = CreateObject("Word.Application")
End Function
'Set appWord = CreateObject("word.application")
Set appWord = CreateObject(Word.Application)
If Err.Number <> 0 Then
'Set appWord = New Word.Application
'Set appWord = CreateObject(Word.Application)
appWord.Visible = True
End If
Several things are wrong with this code. CreateObject wants a ProgID string, and you're giving it Word.Application, which shouldn't even compile (expecting "Object Required" error on the .Application member call, and "Variable not declared"1 on Word). If it compiles, you've referenced the Word object library and need to remove it. The commented-out statement is well-formed.
Now If Err.Number <> 0, then appWord wasn't Set, and its reference is Nothing. That means if CreateObject fails, the code enters an error state and remains in an error state for the remainder of the procedure, because the error is never cleared, and error handling is never restored.
Take the error stuff into its own limited scope:
Private Function GetWordApp() As Object
On Error Resume Next
Set GetWordApp = CreateObject("Word.Application")
End Function
Now your procedure only needs to check if the function returned a valid object reference:
Set appWord = GetWordApp
If appWord Is Nothing Then
'can't get ahold of Word.Application... now what?
Exit Sub
End if
appWord.Visible = True '<~ unconditional
1 assuming Option Explicit is at the top of the module, as it should be.
I have a code. It does not run in 2016.Is it a Office 16 problem
Dim objWordApp as Word.Application
Dim objWordDoc as Word.document
Set objWordApp = new Word.application
I get an error Error in loading DLL .I have already included the library Microsoft word 16.0 Object Library
regards
Anna
I am not sure what went wrong for you but if you just want to open a new word document with your default MS office then you can use this peace of code
Sub wordopener()
Dim objWord
Dim objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
objWord.Visible = True
End Sub
I generally have a BAS file containing the 'CreateWord' function which I drag into any workbook/database that needs it.
First it tests to see if Word is already open using GetObject. If that returns an error it creates an instance of Word using CreateObject.
The Word application can then be opened by simply using Set oWD_App = CreateWord.
Sub Test()
Dim oWD_App As Object
Dim oWD_Doc As Object
Set oWD_App = CreateWord
With oWD_App
Set oWD_Doc = .Documents.Add
End With
End Sub
Public Function CreateWord(Optional bVisible As Boolean = True) As Object
Dim oTempWD As Object
On Error Resume Next
Set oTempWD = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Err.Clear
On Error GoTo ERROR_HANDLER
Set oTempWD = CreateObject("Word.Application")
End If
oTempWD.Visible = bVisible
Set CreateWord = oTempWD
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure CreateWord."
Err.Clear
End Select
End Function
You are trying to use early binding. It is advisable, because it is a bit faster and it gives you intellisense, which is nice. However, to use it, you should add the corresponding libraries.
However, if you use the slower late binding, you do not need to add any libraries. It does not have intellisense and it would be a bit slower (but probably not noticeable).
Try like this:
Option Explicit
Sub TestMe()
Dim objWord As Object
Dim objDoc As Object
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
objWord.Visible = True
End Sub
Early binding vs. late binding: what are the comparative benefits and disadvantages?
Can you please check what am I missing in my code?
When it reaches at wrd.Visible = True, it gives me error "Run-time error 91 : Object variable or With block variable not set".
I have already activated the Microsoft Word 14.0 Object Library
Sub Exceltoword_template()
'Declares and set w as active worksheet
Dim w As Worksheet
Set w = ActiveWorkbook.ActiveSheet
'Declaration for word app
Dim wrd As Object
Dim worddoc As Word.Document
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
'Is MS Word already opened?
' Set wrd = GetObject(class:="Word.Application")
Set wrd = GetObject(class:="Word.Application")
'Clear the error between errors
Err.Clear
'If MS Word is not already open then open MS Word
If wrd Is Nothing Then Set wrd = CreateObject(class:="Word.Application")
' Handle if the Word Application is not found
If Err.Number = 429 Then
MsgBox "Microsoft Word could not be found, aborting."
GoTo EndRoutine
End If
On Error GoTo 0
'Make MS Word Visible and Active
wrd.Visible = True
wrd.Activate
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
I'd generally advise against using early binding, although it can help with the intellisense. I could get the same error as you by omitting the word Set when referencing Word but other than that it worked fine.
Try this code; it doesn't need a reference to Word:
Public Sub Test()
Dim oWD As Object
Dim oDoc As Object
Dim wrkSht As Worksheet
Set wrkSht = ThisWorkbook.Worksheets("Sheet1") 'Be precise, don't trust to Active or Selection.
Set oWD = CreateWD
Set oDoc = oWD.Documents.Add 'Create a new document.
'Set oDoc = oWD.ActiveDocument
'Set oDoc = oWD.Documents("My Document.docx")
'Set oDoc = oWD.Windows("My Document.docx [Compatibility Mode]") '- As it appears on the title bar of the document.
With oDoc
'Coding for Word
End With
End Sub
Public Function CreateWD(Optional bVisible As Boolean = True) As Object
Dim oTmpWD As Object
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Defer error trapping in case Word is not running. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Set oTmpWD = GetObject(, "Word.Application")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'If an error occurs then create an instance of Word. '
'Reinstate error handling. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Err.Number <> 0 Then
Err.Clear
On Error GoTo ERROR_HANDLER
Set oTmpWD = CreateObject("Word.Application")
End If
oTmpWD.Visible = bVisible
Set CreateWD = oTmpWD
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure CreateWD."
Err.Clear
End Select
End Function
I am posting this as reference. It's very similar code I use to open check for Outlook and mirrors your intention exactly, only it simplifies it much more.
'requires early binding (reference set for Microsoft Word Object Library)
'first check if outlook is running and if not open it
Dim wdApp As Word.Application
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wdApp Is Nothing Then Set wdApp = New Word.Application
I have been using this for years without failure.
I wanted my excel macro to create a report by inserting spreadsheet data after Bookmarks I placed in the template word documents.
But I found out that if the template word document is already open, the macro will crash, and consequently the template document will be locked as Read-only and no longer accessible by the macro.
Is there a way to prevent then macro from crashing even if the template word document is already open?
Below is my code
Set wdApp = CreateObject("Word.Application") 'Create an instance of word
Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\Templates\Template_Confirmation.docx") 'Create a new confirmation note
Here comes an evolution of what was suggested in comments :
A function that test if the file is open and offer you to set it directly while testing.
How to use it :
Sub test()
Dim WdDoc As Word.Document
Set WdDoc = Is_Doc_Open("test.docx", "D:\Test\")
MsgBox WdDoc.Content
WdDoc.Close
Set WdDoc = Nothing
End Sub
And the function :
Public Function Is_Doc_Open(FileToOpen As String, FolderPath As String) As Word.Document
'Will open the doc if it isn't already open and set an object to that doc
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
On Error Resume Next
'Set wrdApp = GetObject(, "Word.Application")
If wrdApp Is Nothing Then
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open(FolderPath & FileToOpen)
Else
On Error GoTo NotOpen
Set wrdDoc = wrdApp.Documents(FileToOpen)
GoTo OpenAlready
NotOpen:
Set wrdDoc = wrdApp.Documents.Open(FolderPath & FileToOpen)
End If
OpenAlready:
On Error GoTo 0
Set Is_Doc_Open = wrdDoc
Set wrdApp = Nothing
Set wrdDoc = Nothing
End Function
Only downside of this, you don't have the reference of the Word application...
Any suggestion/evolution are welcome!