J
jawad
Hi
I have created a module that extracts data from word
templates and puts the data into a table. I have used the
API open dialoge box to access the word template from its
directory.The way it works at the moment is that I have to
continuly call the API dialoge box to get the templates
one at a time to extract the data. This is time consuming
and I was wondering if anyone knew how I could extract the
information from the templates automatically without
having to continally call the API dialoge box.
So for example, i have all my templates in the same folder
in the same directory, i want to call my module so that
the API dialoge box opens i then open the first template
and then the module automatically extracts the data from
the templates. I hope this is possible
I have supplied my code below
Thank You in Advance
Jawad
Sub GetWordData()
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
'Note below that I changed GetFileFromAPI
'to be a function returning the chosen file with full path
'Let the user select the file with the path
strDocName = GetFileFromAPI("C:\Documents and
Settings\chaudhryj\")
If strDocName <> "" Then
'User did select something, so proceed
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\chaudhryj\My
Documents\" & _
"ECPA.mdb;"
rst.Open "BPI", cnn, _
adOpenKeyset, adLockOptimistic
With rst
.AddNew
!FamilyName = doc.FormFields("FamilyName").Result
!Forename = doc.FormFields("Forename").Result
!DOB = doc.FormFields("DOB").Result
!MHS_No = doc.FormFields("MHS_No").Result
!NHS_No = doc.FormFields("NHS_No").Result
!PAS_No = doc.FormFields("PAS_No").Result
!NI_No = doc.FormFields("NI_No").Result
!SSD_Ref_No = doc.FormFields("SSD_Ref_No").Result
!Employment = doc.FormFields("Employment").Result
!Address = doc.FormFields("Address").Result
!Post_Code = doc.FormFields("Post_Code").Result
!Tel_No = doc.FormFields("Tel_No").Result
!Time_Address = doc.FormFields("Time_Address").Result
!Perm_Address = doc.FormFields("Perm_Address").Result
!Temp_Address = doc.FormFields("Temp_Address").Result
!No_Address = doc.FormFields("No_Address").Result
!Male = doc.FormFields("Male").Result
!Female = doc.FormFields("Female").Result
!Gender_Unknown = doc.FormFields
("Gender_Unknown").Result
!Ethnicity = doc.FormFields("Ethnicity").Result
!Ethnicity_Other = doc.FormFields
("Ethnicity_Other").Result
!Religion_DD = doc.FormFields("Religion_DD").Result
!Religion_Other = doc.FormFields
("Religion_Other").Result
!Language = doc.FormFields("Language").Result
!Language_Other = doc.FormFields
("Language_Other").Result
!Interpreter_Req = doc.FormFields
("Interpreter_Req").Result
!Referral = doc.FormFields("Referral").Result
!First_Contact = doc.FormFields("First_Contact").Result
!Emergency = doc.FormFields("Emergency").Result
!Keyholder = doc.FormFields("Keyholder").Result
!Carer = doc.FormFields("Carer").Result
!Relative = doc.FormFields("Relative").Result
!Dependants = doc.FormFields("Dependants").Result
!GP = doc.FormFields("GP").Result
!RMO = doc.FormFields("RMO").Result
!Services_Other = doc.FormFields
("Services_Other").Result
.Update
.Close
End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Template 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 If
End Sub
Option Compare Database
Private Declare Function GetOpenFileName _
Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _
(pOpenfilename As OpenFileName) As Long
Private Declare Function GetSaveFileName _
Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" _
(pOpenfilename As OpenFileName) As Long
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
Public Function GetFileFromAPI(ByVal strTitle As String)
As String
Dim OFN As OpenFileName
With OFN
.lStructSize = Len(OFN) ' Size of structure.
.nMaxFile = 260 ' Size of buffer.
' Create buffer.
.lpstrFile = String(.nMaxFile - 1, 0)
.lpstrTitle = strTitle 'Text to be displayed in
title bar
Ret = GetOpenFileName(OFN) ' Call function.
If Ret <> 0 Then ' Non-zero is success.
' Find first null char.
n = InStr(.lpstrFile, vbNullChar)
' Return what's before it.
' Return what's before it.
GetFileFromAPI = Left(.lpstrFile, n - 1)
Else
GetFileFromAPI = ""
End If
End With
End Function
I have created a module that extracts data from word
templates and puts the data into a table. I have used the
API open dialoge box to access the word template from its
directory.The way it works at the moment is that I have to
continuly call the API dialoge box to get the templates
one at a time to extract the data. This is time consuming
and I was wondering if anyone knew how I could extract the
information from the templates automatically without
having to continally call the API dialoge box.
So for example, i have all my templates in the same folder
in the same directory, i want to call my module so that
the API dialoge box opens i then open the first template
and then the module automatically extracts the data from
the templates. I hope this is possible
I have supplied my code below
Thank You in Advance
Jawad
Sub GetWordData()
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
'Note below that I changed GetFileFromAPI
'to be a function returning the chosen file with full path
'Let the user select the file with the path
strDocName = GetFileFromAPI("C:\Documents and
Settings\chaudhryj\")
If strDocName <> "" Then
'User did select something, so proceed
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\chaudhryj\My
Documents\" & _
"ECPA.mdb;"
rst.Open "BPI", cnn, _
adOpenKeyset, adLockOptimistic
With rst
.AddNew
!FamilyName = doc.FormFields("FamilyName").Result
!Forename = doc.FormFields("Forename").Result
!DOB = doc.FormFields("DOB").Result
!MHS_No = doc.FormFields("MHS_No").Result
!NHS_No = doc.FormFields("NHS_No").Result
!PAS_No = doc.FormFields("PAS_No").Result
!NI_No = doc.FormFields("NI_No").Result
!SSD_Ref_No = doc.FormFields("SSD_Ref_No").Result
!Employment = doc.FormFields("Employment").Result
!Address = doc.FormFields("Address").Result
!Post_Code = doc.FormFields("Post_Code").Result
!Tel_No = doc.FormFields("Tel_No").Result
!Time_Address = doc.FormFields("Time_Address").Result
!Perm_Address = doc.FormFields("Perm_Address").Result
!Temp_Address = doc.FormFields("Temp_Address").Result
!No_Address = doc.FormFields("No_Address").Result
!Male = doc.FormFields("Male").Result
!Female = doc.FormFields("Female").Result
!Gender_Unknown = doc.FormFields
("Gender_Unknown").Result
!Ethnicity = doc.FormFields("Ethnicity").Result
!Ethnicity_Other = doc.FormFields
("Ethnicity_Other").Result
!Religion_DD = doc.FormFields("Religion_DD").Result
!Religion_Other = doc.FormFields
("Religion_Other").Result
!Language = doc.FormFields("Language").Result
!Language_Other = doc.FormFields
("Language_Other").Result
!Interpreter_Req = doc.FormFields
("Interpreter_Req").Result
!Referral = doc.FormFields("Referral").Result
!First_Contact = doc.FormFields("First_Contact").Result
!Emergency = doc.FormFields("Emergency").Result
!Keyholder = doc.FormFields("Keyholder").Result
!Carer = doc.FormFields("Carer").Result
!Relative = doc.FormFields("Relative").Result
!Dependants = doc.FormFields("Dependants").Result
!GP = doc.FormFields("GP").Result
!RMO = doc.FormFields("RMO").Result
!Services_Other = doc.FormFields
("Services_Other").Result
.Update
.Close
End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Template 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 If
End Sub
Option Compare Database
Private Declare Function GetOpenFileName _
Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _
(pOpenfilename As OpenFileName) As Long
Private Declare Function GetSaveFileName _
Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" _
(pOpenfilename As OpenFileName) As Long
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
Public Function GetFileFromAPI(ByVal strTitle As String)
As String
Dim OFN As OpenFileName
With OFN
.lStructSize = Len(OFN) ' Size of structure.
.nMaxFile = 260 ' Size of buffer.
' Create buffer.
.lpstrFile = String(.nMaxFile - 1, 0)
.lpstrTitle = strTitle 'Text to be displayed in
title bar
Ret = GetOpenFileName(OFN) ' Call function.
If Ret <> 0 Then ' Non-zero is success.
' Find first null char.
n = InStr(.lpstrFile, vbNullChar)
' Return what's before it.
' Return what's before it.
GetFileFromAPI = Left(.lpstrFile, n - 1)
Else
GetFileFromAPI = ""
End If
End With
End Function