Private Sub Command2_Click()
Dim appWord As Word.Application
Dim doc As Word.Document
Dim MyDB As Database
Dim rst As Recordset
Dim strDocName As String
Dim blnQuitWord As Boolean
strDocName = OpenWordDataFile()
If strDocName = "" Then Exit Sub
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
If appWord Is Nothing Then
Set appWord = CreateObject("Word.Application")
End If
On Error GoTo 0
Set doc = appWord.Documents.Open(strDocName)
Set MyDB = CurrentDb
Set rst = MyDB.OpenRecordset("Input", dbOpenDynaset)
With rst
.AddNew
![OrgID] = doc.ContentControls.Item(1).Range.Text
![OrgNm] = doc.ContentControls.Item(2).Range.Text
![OrgAddr] = doc.ContentControls.Item(3).Range.Text
![Pmaint] = doc.ContentControls.Item(4).Checked
![Prep] = doc.ContentControls.Item(5).Checked
![Pres] = doc.ContentControls.Item(6).Checked
![Omaint] = doc.ContentControls.Item(7).Checked
![Orep] = doc.ContentControls.Item(8).Checked
![Ores] = doc.ContentControls.Item(9).Checked
.Update
.Close
End With
MyDB.Close
doc.Close
If blnQuitWord Then appWord.Quit
MsgBox "Organization Imported!"
Set rst = Nothing
Set doc = Nothing
Set appWord = Nothing
End Sub
Function OpenWordDataFile() As String
With Application.FileDialog(msoFileDialogFilePicker)
' Allow the user to make multiple selections in the dialog box.
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Select word document"
' Clear out the current filters, and then add your own.
.Filters.Clear
.Filters.Add "Word", "*.docx"
.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.
OpenWordDataFile = .SelectedItems(1)
Else
OpenWordDataFile = ""
End If
End With
End Function
Open in new window