Question : Import from Word; how to specify a particular file

I have the code below working well to import fields of data from a MS Word [form] document.

The only problem is that the files MUST be names as show, and in the location specified in the code. "C:\FormName.doc"

How can I change this so a standard "Open File" dialog box pops up, and the user can select the specific Word [form] file that they may have "saved as" with another name
?
(Users may have saved the .doc form as another name; it will still contain all the same fields, it just may have a different file name, and I want them to be able to pick their document)

Code Snippet:

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:



Private Sub cmd_ImportFromWord_Click()
'IMPORT from Word

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

On Error GoTo ErrorHandling

strDocName = "C:\FormName.doc"

Set appWord = GetObject(, "Word.Application")
Set doc = appWord.Documents.Open(strDocName)

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=C:\Documents and Settings\sjeffers\My Documents\Supplier Quality\SCAR-TraK\STtables_EG.mdb"
rst.Open "tbl_ImportFromWord", cnn, _
    adOpenKeyset, adLockOptimistic

With rst
    .AddNew
    'import of data fields
    !SCARIDfixed = doc.FormFields("fldSCARIDfixed").Result
    !SCARCause = doc.FormFields("fldSCARCause").Result
    'ADD OTHER IMPORT FIELDS AS NEEDED
    
    .Update
    .Close
End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Contract Imported!"

Cleanup:
Set rst = Nothing
Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing
Exit Sub
ErrorHandling:
Select Case Err
Case -2147022986, 429
    Set appWord = CreateObject("Word.Application")
    blnQuitWord = True
    Resume Next
Case 5121, 5174
    MsgBox "You must select a valid Word document. " _
        & "No data imported.", vbOKOnly, _
        "Document Not Found"
Case 5941
    MsgBox "The document you selected does not " _
        & "contain the required form fields. " _
        & "No data imported.", vbOKOnly, _
        "Fields Not Found"
Case Else
    MsgBox Err & ": " & Err.Description
End Select
GoTo Cleanup

End Sub

Open in New Window

Select All

Answer : Import from Word; how to specify a particular file

Any name you like.

You can ignore the error or use the attached code

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:



Option Compare Database

Option Explicit


' from http://vbnet.mvps.org/index.html?code/browse/browsenetwork.htm
'Add an editbox to the dialog: SHELL 5.0 or later only!
Private Const BIF_EDITBOX As Long = &H10
'insist on valid result (or CANCEL)
Private Const BIF_VALIDATE As Long = &H20
'Use the new dialog layout with the ability
'to resize: SHELL 5.0 or later only!
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_USENEWUI As Long = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)


Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Const OFN_CREATEPROMPT As Long = &H2000

Private Type OPENFILENAME
    lStructSize As Long
    HwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type


' abstracted so that you can call from no form
Public Function LaunchCdWithOwner(Optional strTitle As String = "Select a File", Optional ByRef strStartDir As String = "C:\") As String
    Dim OpenFile As OPENFILENAME
    Dim sFilter As String
    Dim lReturn As Long
    OpenFile.lStructSize = Len(OpenFile)
    OpenFile.HwndOwner = 0
    sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & _
      "Word File (*.doc)" & Chr(0) & "*.doc" & Chr(0)
    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = 1
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = strStartDir
    OpenFile.lpstrTitle = strTitle
    OpenFile.flags = OFN_CREATEPROMPT
    
    lReturn = GetOpenFileName(OpenFile)
    If lReturn = 0 Then
    Else
        ' trim null char off return value
        LaunchCdWithOwner = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
        ' set the start dir by trimming the file name off the return value
        Dim fn As String
        fn = Trim(Left(OpenFile.lpstrFileTitle, InStr(1, OpenFile.lpstrFileTitle, vbNullChar) - 1))
        strStartDir = Trim(Left(LaunchCdWithOwner, InStr(1, LaunchCdWithOwner, fn) - 1))
    End If
End Function

Open in New Window

Select All