I have a Word template with bookmarks. These bookmarks pull data from an Access database application via VBA code.
On Error GoTo ErrHandler
Me.Recalc
If Me!txtCount = 0 Then
MsgBox "Please select a record to print.", vbOKOnly, "Error"
Else
Dim oWord As Object 'Word.Application
Dim doc As Object 'Word.Document
Set oWord = CreateObject("Word.Application")
Set doc = oWord.Documents.Open("C:\Request_Template.doc")
oWord.Visible = True
Dim oAccess As Object
Dim dbs As Database
Dim rst As Recordset
Dim strCriteria As String
With oWord.ActiveDocument
If .Bookmarks.Exists("DatePage1") = True Then
.Bookmarks("DatePage1").Select
If Not IsNull([Forms]![frmForRequest_Preview]!Date) Then
oWord.selection.Text = (CStr(Format([Forms]![frmForRequest_Preview]!Date, "mmm d, yyyy")))
Else
oWord.selection.Text = ""
End If
End With
End If
Exit Sub
ErrHandler:
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Error"
The question is how to open a copy of the template to allow the user to click on "Save" after reviewing the document? For now the original template is used and the user has to perform "Save As". That is not convenient.
"Template" in Word is a specific file type (.dot, .dotx or .dotm). As it stands, you don't have a Word "template", just a standard Word document (.doc).
Open this .doc in Word and save it as a "Document Template (.dot).
Now, change the line Documents.Open to Documents.Add, referencing the new .dot and changing the parameters to match those of the Add method.
This will automatically open a COPY of the template file, so there is never any danger of the user or your code overwriting the template.
Note, however, that "Save As" is still required since this is a new document, but it will come up automatically - the user won't have to think to use Save As. If you don't want the user to see Save As at all your code needs to perform Document.SaveAs and you need to know the file path and location to which it should be saved.
Related
I have a word document that uses mail merge feature and gets its information from the access db. When I use this code it does not open the word document with the current information. It opens the word document with the last saved information.
If I open the word document on its own, from the task bar, it asks if I want to run the SQL and I click yes and everything operates normally. I want to click a button from within access to accomplish this same task to open the contract.
Here is the code I used:
Private Sub Command205_Click()
Dim LWordDoc As String
Dim oApp As Object
'Path to the word document
LWordDoc = "C:\Users\.....k Up\01- Proposal\contract.docx"
If Dir(LWordDoc) = "" Then
MsgBox "Document not found."
Else
'Create an instance of MS Word
Set oApp = CreateObject(Class:="Word.Application")
oApp.Visible = True
'Open the Document
oApp.Documents.Open FileName:=LWordDoc
End If
End Sub
***I should add that I am not a coder and know nothing about VBA, I copied this from this website so any help you can offer would be greatly appreciated. If you can provide me with coding or enough guidance to get me on the way would be great. Thank you
This code will run in Access to open a Mail Merge document and update content and save.
Using the link I originally posted (http://www.minnesotaithub.com/2015/11/automatic-mail-merge-with-vba-and-access/), I made a couple of modifications and was able to get that code to work.
I needed to add: ReadOnly:=True, _ to prevent a sharing violation
and I changed the Table Name of the source data.
NOTE!! You will need to change sode marked with'###' as follows:
###-1 Change to specify the full path of your TEMPLATE!!!
###-2 Change the SQLSTATEMENT to specify your recordsource!!!
Paste this code into your form, make sure you have a Command Button Click Event that executes (Either rename 'Command205' in this code, or change your control name).
Option Compare Database
Option Explicit
Private Sub Command205_Click()
Dim strWordDoc As String
'Path to the word document of the Mail Merge
'###-1 CHANGE THE FOLLOWING LINE TO POINT TO YOUR DOCUMENT!!
strWordDoc = "C:\Users\.....k Up\01- Proposal\contract.docx"
' Call the code to merge the latest info
startMerge strWordDoc
End Sub
'----------------------------------------------------
' Auto Mail Merge With VBA and Access (Early Binding)
'----------------------------------------------------
' NOTE: To use this code, you must reference
' The Microsoft Word 14.0 (or current version)
' Object Library by clicking menu Tools > References
' Check the box for:
' Microsoft Word 14.0 Object Library in Word 2010
' Microsoft Word 15.0 Object Library in Word 2013
' Click OK
'----------------------------------------------------
Function startMerge(strDocPath As String)
Dim oWord As Word.Application
Dim oWdoc As Word.Document
Dim wdInputName As String
Dim wdOutputName As String
Dim outFileName As String
' Set Template Path
wdInputName = strDocPath ' was CurrentProject.Path & "\mail_merge.docx"
' Create unique save filename with minutes and seconds to prevent overwrite
outFileName = "MailMergeFile_" & Format(Now(), "yyyymmddmms")
' Output File Path w/outFileName
wdOutputName = CurrentProject.Path & "\" & outFileName
Set oWord = New Word.Application
Set oWdoc = oWord.Documents.Open(wdInputName)
' Start mail merge
'###-2 CHANGE THE SQLSTATEMENT AS NEEDED
With oWdoc.MailMerge
.MainDocumentType = wdFormLetters
.OpenDataSource _
Name:=CurrentProject.FullName, _
ReadOnly:=True, _
AddToRecentFiles:=False, _
LinkToSource:=True, _
Connection:="QUERY mailmerge", _
SQLStatement:="SELECT * FROM [tblEmployee]" ' Change the table name or your query
.Destination = wdSendToNewDocument
.Execute Pause:=False
End With
' Hide Word During Merge
oWord.Visible = False
' Save file as PDF
' Uncomment the line below and comment out
' the line below "Save file as Word Document"
'------------------------------------------------
'oWord.ActiveDocument.SaveAs2 wdOutputName & ".pdf", 17
' Save file as Word Document
' ###-3 IF YOU DON'T WANT TO SAVE AS A NEW NAME, COMMENT OUT NEXT LINE
oWord.ActiveDocument.SaveAs2 wdOutputName & ".docx", 16
' SHOW THE DOCUMENT
oWord.Visible = True
' Close the template file
If oWord.Documents(1).FullName = strDocPath Then
oWord.Documents(1).Close savechanges:=False
ElseIf oWord.Documents(2).FullName = strDocPath Then
oWord.Documents(2).Close savechanges:=False
Else
MsgBox "Well, this should never happen! Only expected two documents to be open"
End If
' Quit Word to Save Memory
'oWord.Quit savechanges:=False
' Clean up memory
'------------------------------------------------
Set oWord = Nothing
Set oWdoc = Nothing
End Function
I've tried to use the below code which I found on this conversation How To Search And Replace Across Multiple Files In Word? supplied by Charles Kenyon. However, it doesn't seem to work for me. I've enabled macros on my word and added the below code as a new module in Macros. When I go to replace all, it'll replace the text as per normal, but after doing this, when I open up the other macros enabled word doc, I find that the same text is still in these docs, without being replaced. Am I doing something wrong? Namely, I also wish to add a wildcard entry into my replace all, will the below code work or can someone suggest a better alternative? I have tested the below code with and without wildcard entries to no avail. I've also tried the code on this page in my macros but it also didn't work How to find and replace a text in multiple Word documents using VBAThanks for any help!
Option Explicit
Public Sub BatchReplaceAll()
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
PathToUse = "C:\Test\"
'Error handler to handle error generated whenever
'the FindReplace dialog is closed
On Error Resume Next
'Close all open documents before beginning
Documents.Close SaveChanges:=wdPromptToSaveChanges
'Boolean expression to test whether first loop
'This is used so that the FindReplace dialog will
'only be displayed for the first document
FirstLoop = True
'Set the directory and type of file to batch process
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
'Open document
Set myDoc = Documents.Open(PathToUse & myFile)
If FirstLoop Then
'Display dialog on first loop only
Dialogs(wdDialogEditReplace).Show
FirstLoop = False
Response = MsgBox("Do you want to process " & _
"the rest of the files in this folder", vbYesNo)
If Response = vbNo Then Exit Sub
Else
'On subsequent loops (files), a ReplaceAll is
'executed with the original settings and without
'displaying the dialog box again
With Dialogs(wdDialogEditReplace)
.ReplaceAll = 1
.Execute
End With
End If
'Close the modified document after saving changes
myDoc.Close SaveChanges:=wdSaveChanges
'Next file in folder
myFile = Dir$()
Wend
End Sub
I need to save formatted text from Word in an Access Database.
So far I've managed to figure out how to store formatted text in an Access Field (Create a Memo Field in a Table and set the Text Format as Rich Text). Searching SO I have not yet come across a solution as to how to transport said text from word into Access.
I know that it is possible, because you can do it by simply copying and pasting the information if you are doing it manually.
My question, how can I copy formatted text from word into a field in a table using VBA?
Experimentally I created the following to test this. So far without success...
Sub GetComments()
'Imports Analyst Comments from Excel files als OLE Objects.
'---------------------------------
'Access Variables
Dim dbsFundDB As DAO.Database
Dim rsComments As DAO.Recordset
Set dbsFundDB = CurrentDb
Set rsComments = dbsFundDB.OpenRecordset("tblFunds")
'Word Variables
Dim doc As Word.Application
Dim dcmt As Word.Document
Dim sectn As Word.Section
Dim obCommentText As Object
Dim sAnalystText As String
'Open New Word File
Set doc = New Word.Application
doc.Visible = True
Set dcmt = doc.Documents.Open(sPathTemplate)
Set sectn = dcmt.Sections(1)
sectn.Range.Select
Selection.InsertFile FileName:="myfile.rtf", Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
sAnalystText = sectn.Range.Tables(1).cell(1, 1).Range.FormattedText
rsComments.AddNew
rsComments![Long Comment Exec] = sAnalystText
rsComments.Update
sectn.Range.Select
dcmt.Close savechanges:=False
doc.Quit
End Sub
UPDATE
I tried implementing the answer from Matt Hall. While the text is indeed copied to the database, it does not yet keep the formatting:
Here is my implementation as a simple test:
Option Explicit
Public Const sPathTemplate As String = "W:\L\BDTP\Products\FundResearchTool\Advisory.docx"
Option Compare Database
Sub GetComments()
'Imports Comments from word and save in DB
'Test soubroutine
'---------------------------------
'Word Variables
Dim obCommentText As Variant
Dim strSQL As String
obCommentText = GetWordContent(sPathTemplate)
strSQL = "insert into [tblText]([TestField]) values('" & obCommentText & "')"
DoCmd.RunSQL strSQL
MsgBox "Import Successful", vbInformation Or vbOKOnly
End Sub
Private Function GetWordContent(strFile As String) As Variant
' This function takes the path obtained to the MS-Word Document selected in
' the FileToOpen function and then uses that to open that MS-Word Document
' and retrieve its text contents
Dim objDoc As Word.Document
Set objDoc = GetObject(strFile)
GetWordContent = CVar(objDoc.Sections(1).Range.Text)
objDoc.Close
End Function
Here's a method that heavily references this.
Before you start make sure you have these (or your Access version's equivalent) references ticked in VBA editor > Tools > References:
Microsoft Word 15.0 Object Library
Microsoft Office 15.0 Object Library
Assuming you've set up a form with a command button to trigger this MS-Word import, put the following function and subroutine somewhere in that form's VBA module:
1) File Picker Function:
This will allow you to select the MS-Word Document you want to using the old familiar file dialogue window you see throughout Windows. Ultimately, all it does is save the file path and name of the file you've picked for use in in the subroutine described in (2)...
Private Function FileToOpen() As String
' This function will essentially allow you to browse to MS-Word document
' and then store the path of that file for use in the GetWordContent function
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.Title = "Select Word document to import"
.Filters.Clear
.Filters.Add "Word files", "*.doc?"
If _
.Show = True _
Then
For Each varFile In .SelectedItems
FileToOpen = varFile
Next
Else
FileToOpen = ""
End If
End With
End Function
2) Get Formatted Text Contents of MS-Word Document Subroutine:
This subroutine will use the file path and name of the MS-Word Document selected in the File Picker function (above) to open the MS-Word document, select all the text, copy it to the clipboard, paste it to a text box on an open form in Access and then close MS-Word...
Private Sub GetWordContent(strFile As String)
' This function takes the path obtained to the MS-Word Document selected in
' the FileToOpen function and then uses that to open that MS-Word Document
' and retrieve its text contents and paste them in to WordDocData textbox on
' the currently open form in Access
' Create an MS-Word Object:
Dim objDoc As Object
Set objDoc = CreateObject("Word.Application")
' Open the file selected in FileToOpen() and copy the contents to clipboard:
With objDoc
.Documents.Open strFile
.Visible = True
.Activate
.Selection.WholeStory
.Selection.Copy
End With
' Set the focus to the WordDocData textbox on the Access Form and paste clipboard:
Me.WordDocData.SetFocus
DoCmd.RunCommand acCmdPaste
Me.WordDocDataSrc = strFile
' Save record on the form:
If _
Me.Dirty _
Then
Me.Dirty = False
End If
' A bit hacky this bit. When you close MS-Word after copying a lot of data,
' you might get a message asking you if you if you want to keep the last item
' you copied. This essentially overwrites the clipboard that currently has
' the whole document stored, to just the first 5 characters, which should allow
' MS-Word to be closed here without a pop-up message to deal with:
With objDoc
.Selection.HomeKey Unit:=wdLine
.Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
.Selection.Copy
.Documents.Close
.Quit
End With
Set objDoc = Nothing
End Sub
Your Command Button's On-click Event:
This subroutine should be run from your command button's on-click event. It essentially calls FileToOpen function and the GetWordContent subroutine in order for the user to select a MS-Word Document and then let the VBA copy and paste the formatted text from the MS-Word Document in to a rich text memo textbox on the open form in Access.
Note that this subroutine makes some assumptions, and refers to names of controls/tables/fields and whatnot that you might not have already setup. These assumptions are:
Your form's command button is called cmdGetWordData
Your Access database has a table called tblWordDump
Your form is bound to the table tblWordDump
tblWordDump has 2 memo text fields called WordDocDataSrc and WordDocData to store the imported file path/name and text contents respectively and both are added to your form
Private Sub cmdGetWordData_Click()
' This subroutine runs on your command button; it will call both the FileToOpen function and GetWordContent subroutine
' to retrieve the text contents of your chosen MS-Word Document.
' It will then store both the path the text contents of of your chosen MS-Word Document in 2 fields in a table in Access.
' NOTE: this code assumes that your Access database has:
' - a table called tblWordDump
' - a memo text field in this table called WordDocDataSrc to store the path of MS-Word file imported
' - a memo text field in this table called WordDocData with the TextFormat property set to "Rich Text",
' which will store the text and text formating of the MS-Word file imported
Dim strFile As String
Dim strWordContent As Variant
' Select file via File Dialogue
strFile = FileToOpen
' Conditionals when a file was or wasn't selected
If _
Len(strFile) > 0 _
Then
DoCmd.GoToRecord , , acNewRec
GetWordContent strFile
MsgBox "Import Successful", vbInformation Or vbOKOnly
Else
MsgBox "No File Selected", vbExclamation Or vbOKOnly
End If
End Sub
Here's an example Access file of this for you to poke about in.
Option Compare Database
Function Openword(conPath As String)
Dim appword As Word.Application
Dim doc As Word.Document
On Error Resume Next
Error.Clear
Set appword = GetObject(, "word.application")
If Err.Number <> 0 Then
Set appword = New Word.Application
appword.Visible = True
End If
Set doc = appword.Documents.Open(conPath, , True)
appword.Activate
Set doc = Nothing
Set appword = Nothing
End Function
Private Sub Command5_Click()
Dim mydoc As String
mydoc = "J:\3 - Client Services\1-Programs\12229709.docx"
Call Openword(mydoc)
End Sub
So far I have made the code that will open a specific file when the button on the form is clicked. However, there are a ton of these files that the user needs to be able to select and open. To keep it simple, I want them to be able to open the Word file by simply typing in the name of the file and clicking a button that will find and open it. The name of the file in the example above is simply 12229709.docx, but there are other files similar to it (e.g. 12172029, 12124057...) all in the same location. I want there to be a text box where the user can enter in the number and the button will check that specific folder for a file name with that number in it (without having to add the ".docx" if possible). How do I go about doing this?
EDIT - I forgot to mention that I cannot show the file path or use a file dialog box to allow the user to pick the file because the users that will be choosing the file do not have authorization to access this part of the network.
Try this out
Dim MyValue as Variant
MyValue = Inputbox("Enter File Name")
Dim MyDoc as String
MyDoc = "J:\3 - Client Services\1-Programs\" & MyValue & ".docx"
Call OpenWord(MyDoc)
Not sure if that is what you are looking for but I hope it helps.
I don't know why you'd want to make your user type in a file name when you can just open a file dialog and have them click on the right file.
Just put a command button on your form and include a line "Application.FollowHyperlink" plus this function name. The computer file associations can take care of the rest.
Sub Command()
Application.FollowHyperlink FileName()
End Sub
Public Function FileName() As String
Dim f As Object
' Must have object reference set to a MS Office Object Library for this to work.
Set f = Application.FileDialog(msoFileDialogFilePicker)
With f
.AllowMultiSelect = False
If .Show = -1 Then
FileName = .SelectedItems(1)
End If
End With
FileName = Nz(FileName, "")
End Function
I have an excel project that checks word documents for a changed modify date and, if changed, it opens that document and imports the text from the word form fields into excel.
The routine in excel that opens and imports the word documents is as follows:
Sub CopyFromWord(pFile as String,aFile as string)
Dim wdApp As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
Else 'word is already running
End If
On Error Goto 0
Set wdDoc = wdApp.Documents.Open(Filename:="" & pFile & "", ReadOnly:=True)
wdApp.Visible = False
For Each c In wdDoc.bookmarks
'removed code that copies values from word doc fields to excel sheet
Next c
wdApp.Activedocument.Close SaveChanges:=False
End Sub
The word documents all started out as copies of the same file. There are a few thousand copies of the file, but each located in their own folder with a unique name.
The user finds the folder they need and opens the word document within it. It bring up a userform and then populates formfields in the document with the input to the userform. A command button then saves and exits the form.
Because the welcome message/userform loads automatically upon the document opening, I added the following code into the open event for the document:
Sub Document_Open()
If ThisDocument.ReadOnly = True then Exit Sub
msgbox "Welcome " & Environ$("Username") & ". Click OK to begin."
Userform1.show
End sub
This ensures when the excel project loops through all the files, if it finds one has changed, it needs to open the file (read only) so it can import the data without being interrupted with a userform / welcome message, close it, and carry on searching looping all files checking for changed modify-dates.
It should run constantly, however, about 20% of the time, a document will be opened read only by the excel code, but the welcome messagebox in the word document will show, indicating thisdocument.readonly incorrectly returned false.
If I debug the word document in this scenario, and do
? thisdocument.readonly
I get a "false" result. However, even the title bar of the word document ends with " (Read-Only)" so it has clearly been opened read-only, thus readonly should return True.
It is not specific to any documents, if I try to repeat opening them it seems to work the next time round (in that it correctly registers a read-only and exits the sub before the messagebox code). I cant find any kind of pattern and can't find any info online, I've been searching this for weeks!
May not be considered the answer, but following Tim William's suggestion, I managed to put together this which completely solves my problem. I struggled at first because I was trying to set the property too early. Complete code is as follows:
Sub CopyFromWord(pFile as String)
Dim wdApp As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
Else 'word is already running
End If
On Error Goto 0
'save current setting
secAutomation = wrdApp.Application.AutomationSecurity
'set Word to disable macros when a document is opened via vb:
wrdApp.Application.AutomationSecurity = msoAutomationSecurityForceDisable
'(without using wrdApp prefix it would only apply to the code's App i.e. Excel)
Set wdDoc = wdApp.Documents.Open(Filename:="" & pFile & "", ReadOnly:=True)
wdApp.Visible = False
For Each c In wdDoc.bookmarks
'removed code that copies values from word doc fields to excel sheet
Next c
'restore original setting before closing
wrdApp.Application.AutomationSecurity = secAutomation
wdApp.Activedocument.Close SaveChanges:=False
End Sub
Many thanks to Tim Williams for the link, and the guy who provided the code within the content of that link. This was such a help and is most appreciated.