eciabattari
asked on
Reading MS Word
Hi All - need some suggestions. I have the following code that does the following:
1) Opens MS Word file and returns the names of each FormField
2) Passes FormField name to TableLength and returns the appropriate values
3) Sets array to the proper values
4) Reads the value of each FormField within the file relating to the proper information
This MS Word file has 356 questions and each question has 4 formfields (that's 1,400+ values) that need to be read and added to an MS Access DB.
One way I was thinking of doing this would be create another array with all formfield names (deleting duplicates) and then pass each value. Any suggestions on how to create an array without adding duplicates?
Any suggestions would be helpful.
'------------------------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
Dim appWord As Word.Application
Dim doc As Word.Document
Dim strFormFieldName As String
Function ReadWord()
On Error Resume Next
Dim frm as FormField
Set appWord = CreateObject("Word.Applica tion")
Set doc = appWord.Documents.Open(str WordPath)
strCounter = 0
'returns the name of the FormFields
For Each frm In appWord.ActiveDocument.For mFields
If frm.Type = wdFieldFormCheckBox Then
frm.Select
strFormFieldName = Left$(frm.Name, 2)
ElseIf frm.Type = wdFieldFormTextInput Then
frm.Select
strFormFieldName = Left$(frm.Name, 2)
End If
'sets the form field name, maxrows & table name
Call TableLength(strFormFieldNa me)
'array for calculating the formfields results
ReDim strQA(1 To intMaxRows)
ReDim strQB(1 To intMaxRows)
ReDim strQC(1 To intMaxRows)
ReDim strQT(1 To intMaxRows)
For i = 1 To intMaxRows
strQA(i) = doc.FormFields(strFormName A & i & "a").Result
strQB(i) = doc.FormFields(strFormName B & i & "b").Result
strQC(i) = doc.FormFields(strFormName C & i & "c").Result
strQT(i) = doc.FormFields(strFormName T & i & "t").Result
Next
Next
doc.Close
appWord.Quit
End Function
Private Sub TableLength(strTable As String)
Select Case strTable
Case "GR"
strFormNameA = "GR"
strFormNameB = "GR"
strFormNameC = "GR"
strFormNameT = "GR"
intMaxRows = 16
strTableName = "tblGR"
Case "FG"
strFormNameA = "FG"
strFormNameB = "FG"
strFormNameC = "FG"
strFormNameT = "FG"
intMaxRows = 24
strTableName = "tblFG"
End Select
End Sub
'------------------------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
1) Opens MS Word file and returns the names of each FormField
2) Passes FormField name to TableLength and returns the appropriate values
3) Sets array to the proper values
4) Reads the value of each FormField within the file relating to the proper information
This MS Word file has 356 questions and each question has 4 formfields (that's 1,400+ values) that need to be read and added to an MS Access DB.
One way I was thinking of doing this would be create another array with all formfield names (deleting duplicates) and then pass each value. Any suggestions on how to create an array without adding duplicates?
Any suggestions would be helpful.
'-------------------------
Dim appWord As Word.Application
Dim doc As Word.Document
Dim strFormFieldName As String
Function ReadWord()
On Error Resume Next
Dim frm as FormField
Set appWord = CreateObject("Word.Applica
Set doc = appWord.Documents.Open(str
strCounter = 0
'returns the name of the FormFields
For Each frm In appWord.ActiveDocument.For
If frm.Type = wdFieldFormCheckBox Then
frm.Select
strFormFieldName = Left$(frm.Name, 2)
ElseIf frm.Type = wdFieldFormTextInput Then
frm.Select
strFormFieldName = Left$(frm.Name, 2)
End If
'sets the form field name, maxrows & table name
Call TableLength(strFormFieldNa
'array for calculating the formfields results
ReDim strQA(1 To intMaxRows)
ReDim strQB(1 To intMaxRows)
ReDim strQC(1 To intMaxRows)
ReDim strQT(1 To intMaxRows)
For i = 1 To intMaxRows
strQA(i) = doc.FormFields(strFormName
strQB(i) = doc.FormFields(strFormName
strQC(i) = doc.FormFields(strFormName
strQT(i) = doc.FormFields(strFormName
Next
Next
doc.Close
appWord.Quit
End Function
Private Sub TableLength(strTable As String)
Select Case strTable
Case "GR"
strFormNameA = "GR"
strFormNameB = "GR"
strFormNameC = "GR"
strFormNameT = "GR"
intMaxRows = 16
strTableName = "tblGR"
Case "FG"
strFormNameA = "FG"
strFormNameB = "FG"
strFormNameC = "FG"
strFormNameT = "FG"
intMaxRows = 24
strTableName = "tblFG"
End Select
End Sub
'-------------------------
Explain it slower. How many formfield names have you got and what do they relate to exactly?
ASKER
There are a total of 15 sections, each section could have 8 questions and as many of 90 questions. Each question has 4 formfields (3 are checkboxes & 1 is a text box), example below.
I need to take the results out of the Word file and input them into an MS Access DB. The Access DB has 15 tables, each table represents a different section.
Example:
Yes No N/A Comments
1. Do you know the web?
BTW; I would have never done a survey like this, I would have done a web survey that inputs directly into a DB. However, the powers to be already sent the survey out and I'm stuck getting all the results input into this DB.
Does this expalin it better?
I need to take the results out of the Word file and input them into an MS Access DB. The Access DB has 15 tables, each table represents a different section.
Example:
Yes No N/A Comments
1. Do you know the web?
BTW; I would have never done a survey like this, I would have done a web survey that inputs directly into a DB. However, the powers to be already sent the survey out and I'm stuck getting all the results input into this DB.
Does this expalin it better?
Does strFormNameA wlways equal strFormNameB, strFormNameC and strFormNameT? If so why not ditch strFormNameA, strFormNameB, strFormNameC and strFormNameD and just have strFormName?.
Also, It would be nicer to have local variables for intMaxRows, strTableName and strFormName rather than globals or module level variables.
TableLength could be a function returning the max rows and passing back strTableName and strFormName by reference.
Also, It would be nicer to have local variables for intMaxRows, strTableName and strFormName rather than globals or module level variables.
TableLength could be a function returning the max rows and passing back strTableName and strFormName by reference.
What I meant when I asked the question was I can't see where the duplicates would be unless the same names are repeated.
ASKER
No, strFormNameA, strFormNameB, strFormNameC and strFormNameT do not always equal each other.
Eample:
Section 1 "General Requirements"
Question 1. Yes = strFormNameA = GR1a, No = strFormNameB = GR1b, N/A = strFormNameC = GR1c, Comments = strFormNameT = GR1t
Question 2. Yes = strFormNameA = GR2a, No = strFormNameB = GR2b, N/A = strFormNameC = GR2c, Comments = strFormNameT = GR2t
Section 2 "Formal Groups"
Question 1. Yes = strFormNameA = CA1a, No = strFormNameB = CA1b, N/A = strFormNameC = CA1c, Comments = strFormNameT = CA1t
Question 2. Yes = strFormNameA = CA2a, No = strFormNameB = CA2b, N/A = strFormNameC = CA2c, Comments = strFormNameT = CA2t
Here's the section that returns intMaxRows & other information:
Private Sub TableLength(strTable As String)
Select Case strTable
Case "GR"
strFormNameA = "GR"
strFormNameB = "GR"
strFormNameC = "GR"
strFormNameT = "GR"
intMaxRows = 16
strTableName = "tblGR"
Case "FG"
strFormNameA = "FG"
strFormNameB = "FG"
strFormNameC = "FG"
strFormNameT = "FG"
intMaxRows = 24
strTableName = "tblFG"
End Select
End Sub
Eample:
Section 1 "General Requirements"
Question 1. Yes = strFormNameA = GR1a, No = strFormNameB = GR1b, N/A = strFormNameC = GR1c, Comments = strFormNameT = GR1t
Question 2. Yes = strFormNameA = GR2a, No = strFormNameB = GR2b, N/A = strFormNameC = GR2c, Comments = strFormNameT = GR2t
Section 2 "Formal Groups"
Question 1. Yes = strFormNameA = CA1a, No = strFormNameB = CA1b, N/A = strFormNameC = CA1c, Comments = strFormNameT = CA1t
Question 2. Yes = strFormNameA = CA2a, No = strFormNameB = CA2b, N/A = strFormNameC = CA2c, Comments = strFormNameT = CA2t
Here's the section that returns intMaxRows & other information:
Private Sub TableLength(strTable As String)
Select Case strTable
Case "GR"
strFormNameA = "GR"
strFormNameB = "GR"
strFormNameC = "GR"
strFormNameT = "GR"
intMaxRows = 16
strTableName = "tblGR"
Case "FG"
strFormNameA = "FG"
strFormNameB = "FG"
strFormNameC = "FG"
strFormNameT = "FG"
intMaxRows = 24
strTableName = "tblFG"
End Select
End Sub
ASKER
I figured it out, here's what I did:
1) Created an Array with all FormField Names
2) Removed duplicates from FormField Array
3) Passes FormField Array new array that would get results.
Thanks for the help.
Here's the code:
'------------------------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
Function ReadWord()
On Error Resume Next
'form
Dim frm As FormField
ReDim strArray(1500)
frmMain.txtFilePath.Visibl e = False
Set appWord = CreateObject("Word.Applica tion")
Set doc = appWord.Documents.Open(str WordPath)
strCounter = 0
c = 1
'returns the name of the FormFields
For Each frm In appWord.ActiveDocument.For mFields
If frm.Type = wdFieldFormCheckBox Then
frm.Select
strFormFieldName = Left$(frm.Name, 2)
strArray(c) = strFormFieldName
ElseIf frm.Type = wdFieldFormTextInput Then
frm.Select
strFormFieldName = Left$(frm.Name, 2)
strArray(c) = strFormFieldName
End If
Call ProgressBar(1)
c = c + 1
Next
Call RemoveDuplicates
'Call Import2Access
doc.Close
appWord.Quit
frmMain.cmdSaveWorkbook.Vi sible = True
End Function
Private Sub RemoveDuplicates()
Dim tmpNew() As String, newIndex As Integer
Dim t As Integer
newIndex = 0
For i = 0 To UBound(strArray) - 1
On Error Resume Next
isfound = False
If getArrLength(tmpNew) > -1 Then
For j = 0 To UBound(tmpNew)
If strArray(i) = tmpNew(j) Then
isfound = True
End If
Next j
End If
If isfound = False Then
ReDim Preserve tmpNew(newIndex)
tmpNew(newIndex) = strArray(i)
newIndex = newIndex + 1
End If
Next i
'Display New Array
For i = 0 To UBound(tmpNew)
Call TableLength(tmpNew(i))
Call ProgressBar(2)
'array for calculating the formfields results
ReDim strQA(1 To intMaxRows)
ReDim strQB(1 To intMaxRows)
ReDim strQC(1 To intMaxRows)
ReDim strQT(1 To intMaxRows)
For t = 1 To intMaxRows
Call ProgressBar(2)
strQA(t) = doc.FormFields(strFormName A & t & "a").Result
strQB(t) = doc.FormFields(strFormName B & t & "b").Result
strQC(t) = doc.FormFields(strFormName C & t & "c").Result
strQT(t) = doc.FormFields(strFormName T & t & "t").Result
'Debug.Print tmpNew(i) & " " & intMaxRows & " " & strTableName & " " & strQA(t) _
& " " & strQB(t) & " " & strQC(t)
Next
Next i
End Sub
Private Function getArrLength(v) As Integer
On Error GoTo EH
getArrLength = UBound(v)
Exit Function
EH:
getArrLength = -1
End Function
'------------------------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
1) Created an Array with all FormField Names
2) Removed duplicates from FormField Array
3) Passes FormField Array new array that would get results.
Thanks for the help.
Here's the code:
'-------------------------
Function ReadWord()
On Error Resume Next
'form
Dim frm As FormField
ReDim strArray(1500)
frmMain.txtFilePath.Visibl
Set appWord = CreateObject("Word.Applica
Set doc = appWord.Documents.Open(str
strCounter = 0
c = 1
'returns the name of the FormFields
For Each frm In appWord.ActiveDocument.For
If frm.Type = wdFieldFormCheckBox Then
frm.Select
strFormFieldName = Left$(frm.Name, 2)
strArray(c) = strFormFieldName
ElseIf frm.Type = wdFieldFormTextInput Then
frm.Select
strFormFieldName = Left$(frm.Name, 2)
strArray(c) = strFormFieldName
End If
Call ProgressBar(1)
c = c + 1
Next
Call RemoveDuplicates
'Call Import2Access
doc.Close
appWord.Quit
frmMain.cmdSaveWorkbook.Vi
End Function
Private Sub RemoveDuplicates()
Dim tmpNew() As String, newIndex As Integer
Dim t As Integer
newIndex = 0
For i = 0 To UBound(strArray) - 1
On Error Resume Next
isfound = False
If getArrLength(tmpNew) > -1 Then
For j = 0 To UBound(tmpNew)
If strArray(i) = tmpNew(j) Then
isfound = True
End If
Next j
End If
If isfound = False Then
ReDim Preserve tmpNew(newIndex)
tmpNew(newIndex) = strArray(i)
newIndex = newIndex + 1
End If
Next i
'Display New Array
For i = 0 To UBound(tmpNew)
Call TableLength(tmpNew(i))
Call ProgressBar(2)
'array for calculating the formfields results
ReDim strQA(1 To intMaxRows)
ReDim strQB(1 To intMaxRows)
ReDim strQC(1 To intMaxRows)
ReDim strQT(1 To intMaxRows)
For t = 1 To intMaxRows
Call ProgressBar(2)
strQA(t) = doc.FormFields(strFormName
strQB(t) = doc.FormFields(strFormName
strQC(t) = doc.FormFields(strFormName
strQT(t) = doc.FormFields(strFormName
'Debug.Print tmpNew(i) & " " & intMaxRows & " " & strTableName & " " & strQA(t) _
& " " & strQB(t) & " " & strQC(t)
Next
Next i
End Sub
Private Function getArrLength(v) As Integer
On Error GoTo EH
getArrLength = UBound(v)
Exit Function
EH:
getArrLength = -1
End Function
'-------------------------
I still don't understand.
You seemed to have the names in the first place Why bother going to the trouble of putting them into an array. Why not just put them straight into the database?
A small tip - set Option Explicit and explicitly declare your variables.
To speed things up - the line after
isfound = true
could/should read
Exit For
You seemed to have the names in the first place Why bother going to the trouble of putting them into an array. Why not just put them straight into the database?
A small tip - set Option Explicit and explicitly declare your variables.
To speed things up - the line after
isfound = true
could/should read
Exit For
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.