I have created an application form using MS Word and a whole bunch of form fields, and I have an Access db that can import all the data I need from this Word doc, thanks to this:
http://msdn.microsoft.com/en-us/library/aa155434%28office.10%29.aspx
Now everything works just fine (I even managed to get it to import into multiple tables!), but the problem with the above is that I have to manually enter the name of each file one at a time... which is fine if it's just a case of importing the application form as it comes in... but I have quite a lot sitting in a folder that needs entered into the database.
Then I found this:
How to show "Open File" Dialog in Access 2007 VBA?
I've tried to tweak and merge the two to make it work... but as you can guess, to no avail... (it doesn't help when I'm very much an Access novice!)
What I am looking to do is to be able to import a bunch of Word docs / form fields into MS Access by using the Open / Select file dialogue box... what I've got works, but I'd like to make it easier to work with!
Thanks everyone
Jake
##### Codes I been using
Option Compare Database
Option Explicit
Private Sub cmdFileDialog_Click()
' This requires a reference to the Microsoft Office 11.0 Object Library.
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim appWord As Word.Application
Dim doc As Word.Document
' Dim cnn As New ADODB.Connection
' Dim rst As New ADODB.Recordset
Dim strDocName As String
Dim blnQuitWord As Boolean
' Clear the list box contents.
' Me.FileList.RowSource = ""
' Set up the File dialog box.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Allow the user to make multiple selections in the dialog box.
.AllowMultiSelect = True
' Set the title of the dialog box.
.Title = "Select One or More Files"
' Clear out the current filters, and then add your own.
.Filters.Clear
.Filters.Add "Microsoft Word", "*.DOC"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
' Loop through each file that is selected and then add it to the list box.
For Each varFile In .SelectedItems
' Me.FileList.AddItem varFile
Set appWord = GetObject(, "Word.Application")
Set doc = appWord.Documents.Open(varFile)
' cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
' "Data Source=M:\Medical\GPAppraisal\Contacts & Databases\" & _
' "AppForm.mdb;"
' rst.Open "tbl_Applicants", cnn, _
' adOpenKeyset, adLockOptimistic
' With rst
.addnew
!Title = doc.FormFields("wTitle").Result
!FirstName = doc.FormFields("wFirstName").Result
!LastName = doc.FormFields("wLastName").Result
!Address1 = doc.FormFields("wAddress1").Result
!Address2 = doc.FormFields("wAddress2").Result
!Address3 = doc.FormFields("wAddress3").Result
!City = doc.FormFields("wCity").Result
!PostCode = doc.FormFields("wPostCode").Result
!Email = doc.FormFields("wEmail").Result
!Phone1 = doc.FormFields("wPhone1").Result
!Phone2 = doc.FormFields("wPhone2").Result
!LM = doc.FormFields("wLM").Result
!LMAddress1 = doc.FormFields("wLMAddress1").Result
!LMAddress2 = doc.FormFields("wLMAddress2").Result
!LMAddress3 = doc.FormFields("wLMAddress3").Result
!LMCity = doc.FormFields("wLMCity").Result
!LMPostCode = doc.FormFields("wLMPostCode").Result
!LMEmail = doc.FormFields("wLMEmail").Result
!LMPhone = doc.FormFields("wLMPhone").Result
!LMOK = doc.FormFields("wLMOK").Result
!Probity = doc.FormFields("wProbity").Result
!Practising = doc.FormFields("wPractising").Result
!Signature = doc.FormFields("wSignature").Result
!AppDate = doc.FormFields("wAppDate").Result
!e2011012028 = doc.FormFields("w2011012028").Result
!e2011021725 = doc.FormFields("w2011021725").Result
!e2011030311 = doc.FormFields("w2011030311").Result
!e2011031625 = doc.FormFields("w2011031625").Result
!e20110203 = doc.FormFields("w20110203").Result
!e20110211 = doc.FormFields("w20110211").Result
!e20110322 = doc.FormFields("w20110322").Result
!e20110330 = doc.FormFields("w20110330").Result
.Update
.Close
End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Application Imported!"
Cleanup:
' Set rst = Nothing
' Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
#
I've tried to mess with me.tables and me!forms and .add etc etc - obviously I'm a complete novice here!!!
What I want is to be able to import data from form fields in a Word Doc into a MS Access table (which I have managed to do with the first URL in my original post above); by means of selecting the Word doc from the Open/Select dialogue box, instead of manually entering the names of each Word doc.
My apologies if it sounds obvious or simple - Access is not my strong point by any means!
Before I begin I didn't understand why you have so many uncommented lines (lines beginnig mit ' ) in you code example. I assume that most of those lines would normally not bei uncommented and be part of the working code. Or are there artifacts of the Stack Overflow Editor?
I see a few problems, that might to guide you to a solution.
1) When you use
With fDialog
you let this 'open' until the end of the code (even using a second With in between). I would recommend to set you corresponding 'End With' right after you no longer require it. Remeber (or take note): The
With fDialog
[... something]
' Set the title of the dialog box.
.Title = "Select One or More Files"
is really just a shorthand for
fDialog.Title
(i.e. a "naked" . means, that it has to be appendend to the object in the With) so you could do away with the "With" entirely. IN you example I would set the "End With" right before
If .Show = True Then
and then use
If fDialog.Show = True Then
2) I would set
Set appWord = GetObject(, "Word.Application")
outside your For Each loop (don't forget to take Set appWord = Nothing outside the loop as well). Remember that with GetObject you need an runnig Word-instance, otherwise you might want to use
Set appWord = CreateObject("Word.Application")
or to have it both ways, try to get a Word-object, and if it is not available (i.e. Err.Number = 429) create a new one.
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set appWord = CreateObject("Word.Application")
End If
On Error GoTo 0
3) When working or at least while developping using automation I would always set
objword.Visible = True
so you see error messages or other problems right within Word.
HTH for the next steps (in case you have this problem anymore)
Andreas
Related
I am coding an Access database that will collect user input, then open a Word document and fill out various parts of the document.
The problem I am having is it will only work once for Drop Down Lists. Not sure why or where to look to fix this one. There are three types of items I am programmatically filling in. The first is bookmarks, no problem with this. Second is Content Control Checkboxes, these also work with no problems. The third is Content Control Drop Down Lists, this is where the problem is. First time I open the Access Database it works, but if I click the command button again, nothing (for Drop Downs). The main problem is that it doesn't produce an error message, so I am not sure where to look.
I am guessing it has something to do with the objects I am creating to do the drop down updates? any help would be great:
Dim WordApp As Word.Application
Dim strTemplateLocation As String
Dim dir As String
Dim path As String
Dim wDoc As Word.Document
path = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\"))
strTemplateLocation = path & "UserDoc.docx"
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
WordApp.Visible = True
WordApp.WindowState = wdWindowStateMaximize
WordApp.Documents.Add Template:=strTemplateLocation, newtemplate:=False
With WordApp
'Working Bookmark
.Selection.GoTo what:=wdGoToBookmark, Name:="COMPANY": .Selection.TypeText [fac]
'Working checkbox
If Me.RD = True Then: .ActiveDocument.ContentControls(9).Checked = True
'Works ONCE drop down
Dim objCC As ContentControl
Dim objCE As ContentControlListEntry
Dim ListSelection As String
ListSelection = Me.System_Type.ListIndex + 2
Set objCC = ActiveDocument.ContentControls(1): Set objCE = objCC.DropdownListEntries.Item(ListSelection): objCE.Select
End With
Should I be closing out the objCE and objCC at the end or something?
This is probably your problem:
Set objCC = ActiveDocument.ContentControls(1)
It should be
Set objCC = .ActiveDocument.ContentControls(1)
But much better would be:
Set wDoc = WordApp.Documents.Add(Template:=strTemplateLocation, newtemplate:=False)
and then always use wDoc instead of WordApp.ActiveDocument.
See here: VBA ActiveDocument Concerns / Alternatives?
I have the below code which will use an already open Access database if it's there, if not it will use a new Access instance. This is working fine.
Sub DoStuff()
Dim AccApp As Application
Set AccApp = GetObject("C:\DatabaseName.accdb")
--Do Something e.g.
Debug.Print AccApp.CurrentDb.Name
Set AccApp = Nothing
End Sub
What I want to do after this is to leave the database open if it was already open but close it if it wasn't to start with. How can I tell whether it was there or not to start with.
I don't want to test for laccdb files as these can remain after Access closing unexpectedly.
Any ideas most appreciated.
I managed to crowbar another function I had for another purpose into this which solves the issue:
Function bDatabaseOpen(strDBPath As String) As Boolean
Dim objWMIService As Object, colProcessList As Object, objProcess As Object
bDatabaseOpen = False
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'MSACCESS.EXE'")
For Each objProcess In colProcessList
If Not (IsNull(objProcess.commandline)) Then
If objProcess.commandline Like "*" & strDBPath & "*" Then
bDatabaseOpen = True
End If
End If
Next
Set objProcess = Nothing
Set objWMIService = Nothing
Set colProcessList = Nothing
End Function
I can test prior to calling my original code if it's already open and then afterwards deal with it appropriately.
IMO the easiest way is to try to delete the .laccdb file. If it's there and can't be deleted (because it is locked), the Db is in use.
Const TheDB = "C:\DatabaseName.accdb"
Dim DbWasOpen As Boolean
Dim slaccdb As String
slaccdb = Replace(TheDB, ".accdb", ".laccdb")
DbWasOpen = False
If Dir$(slaccdb) <> "" Then
On Error Resume Next
' Try to delete .laccdb
Kill slaccdb
' If that fails, the database is in use
If Err.Number <> 0 Then
DbWasOpen = True
End If
On Error GoTo 0
End If
I am creating and opening a word document through access 2007 vba. The document is created but the focus is not shifted to word. Instead the focus still remains on access form through which am creating the doc. Below is my code:
Dim obj As Word.Application
Dim wor As Word.Document
Dim str As String
str = "C:\hello\folder1\vin.dot"
Set obj = CreateObject("Word.Application")
Set wor = obj.Documents.Add
With wor
.SaveAs str
.Close
End With
obj.Visible = True
obj.Documents.Open str
obj.WindowState = wdWindowStateMaximize
Any sugesstions please.
You can move the focus with AppActivate;
AppActivate "Microsoft Word"
The VBA Word.Application object may have more than one Window associated with it. You may specify which Window to display by using its Caption property.
Since you created a new Word.Application and only created one Document, you may assume that the 1st element (1-based array) is what you want to display in your code.
AppActivate (obj.Windows(1).Caption)
I was able to call the specific window even with other word documents open with the following:
Private Sub but_Click()
'must add tools > references Microsoft Word XX.X Object Library (xx.x is max update)
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
strProjPath = Application.CurrentProject.Path 'get current path
strVerWord = "test" 'i use this to identify paths that can change based on network configs.
posOp = InStr(1, strProjPath, strVerWord) ' find the verification word in the path
strVerPath = "strVerWord filepath\FP\FP\document.docx" 'create string location for document
strPathPlusDBName = Left(strProjPath, posOp - 1) & strVerPath
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(FileName:=strPathPlusDBName, ReadOnly:=True) 'open word file in read only
AppActivate WordDoc
End Sub
I have a inventory/Contact database where I need to store a lot of images (10k items, 1k people). Now, obviously ole object is out of the question due to the sheer bloat.
Is there a better way to do this, such as storing the pathway to the image ( would be stored in a folder with the database) and having that image displayed where I need it(this would be great because some items are repeated)? Is there anyway to do this? (also, i really need to have a filebrowser to the actual image instead of typing the path manually (that would be hell))
Here is a concept
Sub Locate_File()
Dim fDialog As Office.FileDialog
Dim file_path As String
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
'Set the title of the dialog box.
.Title = "Please select one or more files"
'Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "All Files", "*.*"
'Show the dialog box. If the .Show method returns True, the
'user picked at least one file. If the .Show method returns
'False, the user clicked Cancel.
If .Show = True Then
file_path = .SelectedItems(1)
Copy_file(file_path,Right(file_path, Len(file_path) - InStrRev(file_path, "\")))
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End
Sub Copy_file(old_path As String, file_name As String)
Dim fs As Object
Dim images_path As String
images_path = CurrentProject.Path & "\images\"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile old_path, images_path & file_name
Set fs = Nothing
'Update your database with the file location of images_path & file_name
End
You may need to make changes and you must require the Microsoft Office 12.0 Object Library for FileDialog to work. Much of the FileDialog code was taken from Microsoft
I'm working on a Access database which generates some mails with mail merge called from VBA code in the Access database. The problem is that if I open a new Word document and start the mail merge (VBA), Word opens the same Access database (which is already open) to get the data. Is there any way to prevent this? So that the already opened instance of the database is used?
After some testing I get a strange behavior: If I open the Access database holding the SHIFT-Key the mail merge does not open an other Access instance of the same database. If I open the Access database without holding the key, I get the described behavior.
My mail merge VBA code:
On Error GoTo ErrorHandler
Dim word As word.Application
Dim Form As word.Document
Set word = CreateObject("Word.Application")
Set Form = word.Documents.Open("tpl.doc")
With word
word.Visible = True
With .ActiveDocument.MailMerge
.MainDocumentType = wdMailingLabels
.OpenDataSource Name:= CurrentProject.FullName, ConfirmConversions:=False, _
ReadOnly:=False, LinkToSource:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
SQLStatement:="[MY QUERY]", _
SQLStatement1:="", _
SubType:=wdMergeSubTypeWord2000, OpenExclusive:=False
.Destination = wdSendToNewDocument
.Execute
.MainDocumentType = wdNotAMergeDocument
End With
End With
Form.Close False
Set Form = Nothing
Set word = Nothing
Exit_Error:
Exit Sub
ErrorHandler:
word.Quit (False)
Set word = Nothing
' ...
End Sub
The whole thing is done with Access / Word 2003.
Update #1
It would also help if someone could tell me what the exact difference is between opening Access with or without the SHIFT-Key. And if it is possible to write some VBA code to enable the "features" so if the database is opened without the SHIFT-Key, it at least "simulates" it.
Cheers,
Gregor
When I do mailmerges, I usually export a .txt file from Access and then set the mail merge datasource to that. That way Access is only involved in exporting the query and then telling the Word document to do the work via automation, roughly as follows:
Public Function MailMergeLetters()
Dim pathMergeTemplate As String
Dim sql As String
Dim sqlWhere As String
Dim sqlOrderBy As String
'Get the word template from the Letters folder
pathMergeTemplate = "C:\MyApp\Resources\Letters\"
'This is a sort of "base" query that holds all the mailmerge fields
'Ie, it defines what fields will be merged.
sql = "SELECT * FROM MailMergeExportQry"
With Forms("MyContactsForm")
' Filter and order the records you want
'Very much to do for you
sqlWhere = GetWhereClause()
sqlOrderBy = GetOrderByClause()
End With
' Build the sql string you will use with this mail merge
sql = sql & sqlWhere & sqlOrderBy & ";"
'Create a temporary QueryDef to hold the query
Dim qd As DAO.QueryDef
Set qd = New DAO.QueryDef
qd.sql = sql
qd.Name = "mmexport"
CurrentDb.QueryDefs.Append qd
' Export the data using TransferText
DoCmd.TransferText _
acExportDelim, , _
"mmexport", _
pathMergeTemplate & "qryMailMerge.txt", _
True
' Clear up
CurrentDb.QueryDefs.Delete "mmexport"
qd.Close
Set qd = Nothing
'------------------------------------------------------------------------------
'End Code Block:
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'Start Code Block:
'OK. Access has built the .txt file.
'Now the Mail merge doc gets opened...
'------------------------------------------------------------------------------
Dim appWord As Object
Dim docWord As Object
Set appWord = CreateObject("Word.Application")
appWord.Application.Visible = True
' Open the template in the Resources\Letters folder:
Set docWord = appWord.Documents.Add(Template:=pathMergeTemplate & "MergeLetters.dot")
'Now I can mail merge without involving currentproject of my Access app
docWord.MailMerge.OpenDataSource Name:=pathMergeTemplate & "qryMailMerge.txt", LinkToSource:=False
Set docWord = Nothing
Set appWord = Nothing
'------------------------------------------------------------------------------
'End Code Block:
'------------------------------------------------------------------------------
Finally:
Exit Function
Hell:
MsgBox Err.Description & " " & Err.Number, vbExclamation, APPHELP
On Error Resume Next
CurrentDb.QueryDefs.Delete "mmexport"
qd.Close
Set qd = Nothing
Set docWord = Nothing
Set appWord = Nothing
Resume Finally
End Function
To use this, you need to set up your Resources\Letters subfolder and put your mailmerge template word file in there. You also need your "base" query with the field definitions in your Access App (in the example, it is called MailMergeExportQry. But you can call it anything.
You also need to figure out what filtering and sorting you will do. In the example, this is represented by
sqlWhere = GetWhereClause()
sqlOrderBy = GetOrderByClause
Once you have got your head round those things, this is highly reusable.