J
jawad
Hi
I am in a bit of a pickle, and I was wondering if anyone
could help.
I have created a module that trawls through a word
template and extracts the data into a table in access. At
the moment to extract the data from the specific template
you need to manually write the path name in a input box.
I have also created a module that opens the open/save
dialog box (using the API)
My problem is that i want to link the two modules togeater
so that when I open the open\save dialog box and search
for the relevant file, the file name is inserted into the
input box created in the first module. I hope this makes
sense.
I have included the code of the two modules below
Thanks in Advance
Jawad
FIRST MODULE
code:------------------------------------------------------
--------------------------
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
strDocName = "C:\Documents and Settings\chaudhryj\My
Documents\" & _
InputBox("Enter the name of the Word template " & _
"you want to import:", "Import template")
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 "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----------------------------------------------------
----------------------------
SECOND MODULE
code:------------------------------------------------------
--------------------------
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
Sub GetFileFromAPI()
Dim OFN As OPENFILENAME
With OFN
.lStructSize = Len(OFN) ' Size of structure.
.nMaxFile = 260 ' Size of buffer.
' Create buffer.
.lpstrFile = String(.nMaxFile - 1, 0)
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.
MsgBox Left(.lpstrFile, n - 1)
End If
End With
End Sub
I am in a bit of a pickle, and I was wondering if anyone
could help.
I have created a module that trawls through a word
template and extracts the data into a table in access. At
the moment to extract the data from the specific template
you need to manually write the path name in a input box.
I have also created a module that opens the open/save
dialog box (using the API)
My problem is that i want to link the two modules togeater
so that when I open the open\save dialog box and search
for the relevant file, the file name is inserted into the
input box created in the first module. I hope this makes
sense.
I have included the code of the two modules below
Thanks in Advance
Jawad
FIRST MODULE
code:------------------------------------------------------
--------------------------
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
strDocName = "C:\Documents and Settings\chaudhryj\My
Documents\" & _
InputBox("Enter the name of the Word template " & _
"you want to import:", "Import template")
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 "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----------------------------------------------------
----------------------------
SECOND MODULE
code:------------------------------------------------------
--------------------------
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
Sub GetFileFromAPI()
Dim OFN As OPENFILENAME
With OFN
.lStructSize = Len(OFN) ' Size of structure.
.nMaxFile = 260 ' Size of buffer.
' Create buffer.
.lpstrFile = String(.nMaxFile - 1, 0)
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.
MsgBox Left(.lpstrFile, n - 1)
End If
End With
End Sub