May 17th, 2013
I recent was asked the following question in an UtterAccess forum and thought the solution could be useful to someone else down the line.
I have an access database with hyperlinks to many protected word documents (write protection only).
The target is : user enters a search string in access and selects specific protected document.
In the thread I developed 2 possible solutions: (1) Open the document and highlight the search term throughout the document, (2) Open the document and the start the Find dialog and allow the user the control of what they do from that point on.
Open the document and highlight the search term throughout the document
'---------------------------------------------------------------------------------------
' Procedure : OpenWordDocAndSearch
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Open the document and highlight the search term throughout the document
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFileName : Fully qualified path and filename with extension of the word document
' to search through
' sSearchString : The search term to look for
'
' Usage:
' ~~~~~~
' OpenWordDocAndSearch "c:\demo\Test.docx", "The"
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2013-May-15 Initial Release
'---------------------------------------------------------------------------------------
Function OpenWordDocAndSearch(sFileName As String, sSearchString As String)
On Error GoTo Error_Handler
Dim oApp As Object
Dim oDoc As Object
Const wdYellow = 7
On Error Resume Next
Set oApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't running so start it
Set oApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set oDoc = oApp.Documents.Open(sFileName)
oApp.Visible = True
oDoc.Content.Find.HitHighlight FindText:=sSearchString
Error_Handler_Exit:
On Error Resume Next
Set oDoc = Nothing
Set oApp = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: OpenWordDoc" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function |
Open the document and the start the Find dialog and allow the user the control of what they do from that point on
'---------------------------------------------------------------------------------------
' Procedure : OpenWordDocAndSearch
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Open the document and the start the Find dialog and allow the user the
' control of what they do from that point on
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFileName : Fully qualified path and filename with extension of the word document
' to search through
' sSearchString : The search term to look for
'
' Usage:
' ~~~~~~
' OpenWordDocAndSearch "c:\demo\Test.docx", "The"
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2013-May-15 Initial Release
'---------------------------------------------------------------------------------------
Function OpenWordDocAndSearch(sFileName As String, sSearchString As String)
On Error GoTo Error_Handler
Dim oApp As Object
Dim oDoc As Object
Dim dlgFind As Object
Const wdDialogEditFind = 112
On Error Resume Next
Set oApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't running so start it
Set oApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set oDoc = oApp.Documents.Open(sFileName)
oApp.Visible = True
Set dlgFind = oApp.Dialogs(wdDialogEditFind)
With dlgFind
.Find = sSearchString
.Show
End With
Error_Handler_Exit:
On Error Resume Next
Set dlgFind = Nothing
Set oDoc = Nothing
Set oApp = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: OpenWordDocAndSearch" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function |
Share and Enjoy
MS Access - Word Automation | 
No Comments »
December 9th, 2012
Over the years, I have answered numerous questions regarding how to export a records, or records to either MS Excel or MS Word. I already have 2 posts on the subject:
but thought a concrete example would help illustrate things even further.
Here are a few screenshots of the sample.
Now in this sample I am covering Excel and Word automation, not built-in commands, such as:
- DoCmd.TransferSpreadsheet
- DoCmd.TransferText
- DoCmd.OutputTo
- DoCmd.RunCommand acCmdExportRTF
These are well documented, and plenty of examples can be found online. Instead, I concentrate on demonstrating a few possible ways to export using late binding and word and excel automation, permitting much more control on the final product (font, colors, layout, page orientation and so much more) and no need for any external reference libraries.
Note: for this sample to work, all the supporting files (excel and word) must be in the same folder as the database itself (although this very easy to change in the VBA code provided).
Fill In Excel Or Word Access Demo
Share and Enjoy
MS Access - Excel Automation, MS Access - Word Automation, MS Access Samples | No Comments »
May 14th, 2012
I was asked in a support forum how to convert an Excel *.xls, *.xlsx file to *.csv format. I didn’t readily have an answer so I created a custom function to help the user out. So here are the fruits on my labors should it help someone else out. What is also nice about the way it is written, is that it will run in any MS Office application (MS Access, MS Word, MS PowerPoint, MS Outlook, …) without requiring any modifications (copy & paste, that’s it)!
'---------------------------------------------------------------------------------------
' Procedure : ConvertXls2CSV
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Converts a standard Excel file to csv format
' Requirements: Requires MS Excel be installed
' Uses late binding, so no libraries need be declared
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sXlsFile : Fully qualified path and filename with extension of the Excel workbook
'
' Usage:
' ~~~~~~
' ConvertXls2CSV "C:\Users\Daniel\Desktop\Contact_E-mail listing.xls"
' Will output a file C:\Users\Daniel\Desktop\Contact_E-mail listing.csv
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2012-May-11 Initial Release - Answer to forum question
'---------------------------------------------------------------------------------------
Function ConvertXls2CSV(sXlsFile As String)
On Error Resume Next
Dim oExcel As Object
Dim oExcelWrkBk As Object
Dim bExcelOpened As Boolean 'Was Excel already open or not
'Review 'XlFileFormat Enumeration' for more formats
Const xlCSVWindows = 23 'Windows CSV Format
Const xlCSV = 6 'CSV
Const xlCSVMac = 22 'Macintosh CSV
Const xlCSVMSDOS = 24 'MSDOS CSV
Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oExcel = CreateObject("excel.application")
bExcelOpened = False
Else 'Excel was already running
bExcelOpened = True
End If
On Error GoTo Error_Handler
oExcel.ScreenUpdating = False
oExcel.Visible = False 'Keep Excel hidden from the user
oExcel.Application.DisplayAlerts = False
Set oExcelWrkBk = oExcel.Workbooks.Open(sXlsFile)
'Note: you may wish to change the file format constant for another type declared
' above based on your usage/needs in the following line.
oExcelWrkBk.SaveAs Left(sXlsFile, InStrRev(sXlsFile, ".")) & "csv", xlCSVWindows
oExcelWrkBk.Close False
If bExcelOpened = False Then
oExcel.Quit
End If
Error_Handler_Exit:
On Error Resume Next
Set oExcelWrkBk = Nothing
Set oExcel = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ConvertXls2CSV" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function |
Now this could be further improved by extending the error handling further to trap specific errors such as 1004 – file not found, etc… but it definitely illustrates the basic principle in using late binding to utilize Excel to open the file and convert it to *.csv format.
I hope this helps.
Share and Enjoy
MS Access - Excel Automation, MS Access - Outlook Automation, MS Access - Word Automation, MS Access VBA Programming, MS Excel VBA Programming, MS Office, MS Word VBA Programming | No Comments »
April 23rd, 2012
Similarily to my post regarding exporting records to MS Excel, below is some sample code that illustrates how one can export data into a new Word document (in a table structure). The code determines the necessary rows and columns based on the table or query passed to it and then does the rest. You can easily from this simple example get into formatting fonts, etc…
'---------------------------------------------------------------------------------------
' Procedure : Export2DOC
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Export a recordset to a MS Word table in a new document
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
'
'
' Usage:
' ~~~~~~
'
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2012-Apr-23 Initial Release
'---------------------------------------------------------------------------------------
Function Export2DOC(sQuery As String)
Dim oWord As Object
Dim oWordDoc As Object
Dim oWordTbl As Object
Dim bWordOpened As Boolean
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim iCols As Integer
Dim iRecCount As Integer
Dim iFldCount As Integer
Dim i As Integer
Dim j As Integer
Const wdPrintView = 3
Const wdWord9TableBehavior = 1
Const wdAutoFitFixed = 0
'Start Word
On Error Resume Next
Set oWord = GetObject("Word.Application") 'Bind to existing instance of Word
If Err.Number <> 0 Then 'Could not get instance of Word, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oWord = CreateObject("Word.application")
bWordOpened = False
Else 'Word was already running
bWordOpened = True
End If
On Error GoTo Error_Handler
oWord.Visible = False 'Keep Word hidden until we are done with our manipulation
Set oWordDoc = oWord.Documents.Add 'Start a new document
'Open our SQL Statement, Table, Query
Set db = CurrentDb
Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)
With rs
If .RecordCount <> 0 Then
.MoveLast 'Ensure proper count
iRecCount = .RecordCount 'Number of records returned by the table/query
.MoveFirst
iFldCount = .Fields.Count 'Number of fields/columns returned by the table/query
oWord.ActiveWindow.View.Type = wdPrintView 'Switch to print preview mode (not req'd just a personal preference)
oWord.ActiveDocument.Tables.Add Range:=oWord.Selection.Range, NumRows:=iRecCount, NumColumns:= _
iFldCount, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
Set oWordTbl = oWordDoc.Tables(1)
'Build our Header Row
For i = 0 To iFldCount - 1
oWordTbl.Cell(1, i + 1) = rs.Fields(i).Name
Next i
'Build our data rows
For i = 1 To iRecCount
For j = 0 To iFldCount - 1
oWordTbl.Cell(i + 1, j + 1) = Nz(rs.Fields(j).Value, "")
Next j
.MoveNext
Next i
Else
MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Word spreadsheet with"
GoTo Error_Handler_Exit
End If
End With
' oWordDoc.Close True, sFileName 'Save and close
'Close Word if is wasn't originally running
' If bWordOpened = False Then
' oWord.Quit
' End If
Error_Handler_Exit:
On Error Resume Next
oWord.Visible = True 'Make Word visible to the user
rs.Close
Set rs = Nothing
Set db = Nothing
Set oWordTbl = Nothing
Set oWordDoc = Nothing
Set oWord = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Export2DOC" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function |
You may also wish to review my MS Access Sample- Export Data to Excel and/or Word
Share and Enjoy
MS Access - Word Automation, MS Access Queries, MS Access Tables, MS Access VBA Programming | No Comments »
September 10th, 2010
Similarily to my previous post entitled VBA – Word – Enumerate/List All Form Fields you can just as easily produce a listing of all the Bookmarks of a Word document. The following procedure does exactly that.
'---------------------------------------------------------------------------------------
' Procedure : EnumerateDocBkMrks
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Generate a listing of all the Bookmarks containing within the
' specified word document and print them to the immediate window.
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2010-Sep-10 Initial Release
'---------------------------------------------------------------------------------------
Function EnumerateDocBkMrks(sFileName As String)
On Error GoTo Error_Handler
'Requires a reference to the Word object library
Dim oApp As Word.application
Dim oDoc As Word.Document
Dim dBkMrk As Bookmark
On Error Resume Next
Set oApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't running so start it
Set oApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set oDoc = oApp.Documents.Open(sFileName)
oApp.Visible = False 'Control whether or not Word becomes
'visible to the user
'Loop through each form field
For Each dBkMrk In oDoc.Range.Bookmarks
Debug.Print dBkMrk.Name
Next
Error_Handler_Exit:
On Error Resume Next
oDoc.Close False
oApp.Quit
Set oDoc = Nothing
Set oApp = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
" Error Number: " & Err.Number & vbCrLf & _
" Error Source: EnumerateDocBkMrks" & vbCrLf & _
" Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function |
Share and Enjoy
MS Access - Word Automation | 1 Comment »
September 10th, 2010
Have you ever started coding some vba to manipulate a Word document’s form fields and started going back and forth between the word document and the VBE. This can work if you have a few form fields, but becomes very tiresome when dealing with large form. As such, I created a very simple procedure to extract a list of the form fields in one shot and then I could continue my work in peace. I hope the following saves you some time and frustrations too.
'---------------------------------------------------------------------------------------
' Procedure : EnumerateDocFrmFlds
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Generate a listing of all of the form fields containing within the
' specified word document and print them to the immediate window.
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2010-Sep-10 Initial Release
'---------------------------------------------------------------------------------------
Function EnumerateDocFrmFlds(sFileName As String)
On Error GoTo Error_Handler
'Requires a reference to the Word object library
Dim oApp As Word.application
Dim oDoc As Word.Document
Dim dFormField As FormField
On Error Resume Next
Set oApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't running so start it
Set oApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set oDoc = oApp.Documents.Open(sFileName)
oApp.Visible = False 'Control whether or not Word becomes
'visible to the user
'Loop through each form field
For Each dFormField In oDoc.FormFields()
Debug.Print dFormField.Name
Next
Error_Handler_Exit:
On Error Resume Next
oDoc.Close False
oApp.Quit
Set oDoc = Nothing
Set oApp = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
" Error Number: " & Err.Number & vbCrLf & _
" Error Source: EnumerateDocFrmFlds" & vbCrLf & _
" Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function |
Share and Enjoy
MS Access - Word Automation | No Comments »
September 9th, 2010
If you have ever needed to open a Word document and are looking for an alternative method to the Application.FollowHyperlink method, then the following procedure using Word automation should do the trick.
'---------------------------------------------------------------------------------------
' Procedure : OpenWordDoc
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Open the specified Word document
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2010-Sep-09 Initial Release
'---------------------------------------------------------------------------------------
Function OpenWordDoc(sFileName As String)
On Error GoTo Error_Handler
'Requires a reference to the Word object library
Dim oApp As Word.Application
Dim oDoc As Word.Document
On Error Resume Next
Set oApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't running so start it
Set oApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set oDoc = oApp.Documents.Open(sFileName)
oApp.Visible = True
Error_Handler_Exit:
On Error Resume Next
Set oDoc = Nothing
Set oApp = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: OpenWordDoc" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function |
Share and Enjoy
MS Access - Word Automation | 2 Comments »
September 3rd, 2010
The following code will print out a word document.
'---------------------------------------------------------------------------------------
' Procedure : PrintDoc
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Print a Word Document
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strDoc - The path and filename of the document to be printes
' intCopies - The number of copies to be printed
'
' Usage:
' ~~~~~~~~~~~~~~~~
' PrintDoc("c:\management\evaluation.doc",1)
'---------------------------------------------------------------------------------------
Function PrintDoc(strDoc As String, intCopies As Integer)
Dim WordObj As Object
Set WordObj = CreateObject("Word.Application")
WordObj.Documents.Open strDoc
WordObj.PrintOut Background:=False, Copies:=intCopies
WordObj.Documents.Close SaveChanges:=wdDoNotSaveChanges
WordObj.Quit
Set WordObj = Nothing
End Function |
Share and Enjoy
MS Access - Word Automation, MS Word VBA Programming | No Comments »
September 3rd, 2010
The following procedure will launch MS Word. The beauty is it uses late binding so you do not need to use reference libraries and as such avoid/minimize versioning issues. This same procedure can easily be modified to launch just about any MS Office application by simply changing the “Word.Application” portions of the code to correspond with the application you are trying to automate.
A few other strings used for common MS Office application are:
- Excel – “Excel.Application”
- Access – “Access.Application”
- Publisher – “Publisher.Application”
- PowerPoint – “Powerpoint.Application”
Sub LaunchWord()
Dim objApp As Object
'See if Word is already running
On Error Resume Next
Set objApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.Clear
On Error GoTo Error_Handler
Set objApp = CreateObject("Word.Application")
objApp.Visible = True 'Make the application visible to the user (if wanted)
End If
Exit Sub
Error_Handler:
MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Source: LaunchWord" & vbCrLf & "Error Description: " & _
Err.Description, vbCritical, "An Error has Occured!"
Exit Sub
End Sub |
Share and Enjoy
MS Access - Word Automation, MS Word VBA Programming | No Comments »
