Here is the final code for the sub which reads Word tables and puts the data into Access tables.
Code:
Public Sub ReadTables()
On Error GoTo Err_Handler
If sPath = "" Then GoTo Err_Handler
Dim objwd As Word.Application
Dim doc As New Word.Document
Dim BM As Word.Bookmark
Dim tbl As Word.Table
Dim Row As Word.Row
Dim Col As Word.Column
Dim Cell As Word.Cell
Dim rowcount As Integer
Dim strBookMarkName As String
Dim strPartNumber As String
Dim strCAGE As String
Dim strNomenclature As String
Dim datStart As Date
Dim datEnd As Date
Dim strMainTask As String
Dim lngMainTaskID As Long
Dim lngDocID As Long
Dim bolDocHasData As Boolean
Dim bolTableHasData As Boolean
Dim bolRowHasData As Boolean
Dim strTaskName As String
Dim datMinDate As Date
Dim datMaxDate As Date
Dim datDocMinDate As Date
Dim datDocMaxDate As Date
Dim strSQL As String
Set objwd = New Word.Application
Set doc = objwd.Documents.Open(sPath)
For Each BM In doc.Bookmarks
strBookMarkName = BM.Name
If Left(strBookMarkName, 3) = "tbl" And BM.Range.Information(12) Then
Set tbl = BM.Range.Tables(1)
Debug.Print "Table: " & strBookMarkName
If tbl.Rows.Count > 1 Then
'CreateTempTable
Select Case strBookMarkName
Case "tblCalFailureModeAnalysis"
strMainTask = "Calibration Failure Mode Analysis"
Case "tblCalIntervalAnalysis"
strMainTask = "Calibration Interval Analysis"
Case "tblCalTrainingPlan"
strMainTask = "Calibration Training Plan and Site standup"
Case "tblCaStandardsForInitialCapability"
strMainTask = "Calibration standards for initial capability"
Case "tblCMRSReview"
strMainTask = "Calibration Measurement Requirements Summary (CMRS) Review"
Case "tblComSP"
strMainTask = "Commercial Service Provider (ComSP) Audit"
Case "tblCRATable"
strMainTask = "Calibration Requirements Analysis (CRA)"
Case "tblICP"
strMainTask = "Instrument Calibration Procedure (ICP) Review and Development"
Case "tblMeasurementTraceability"
strMainTask = "Measurement Traceability Report and Certification"
Case "tblResearchAndDevelopment"
strMainTask = "Research and Development"
End Select
'DoCmd.RunSQL "INSERT INTO tblTasks (FundingDocID, TaskName) SELECT " & lngFundingDocID & ", '" & strMainTask & "';"
lngMainTaskID = DMax("[ID]", "tblTasks")
datMinDate = #12:00:00 AM#
datMaxDate = #12:00:00 AM#
bolTableHasData = False
For Each Row In tbl.Rows
If Row.Index > 1 Then
strPartNumber = ""
strCAGE = ""
strNomenclature = ""
datStart = #12:00:00 AM#
datEnd = #12:00:00 AM#
bolRowHasData = False
For Each Cell In Row.Cells
'Debug.Print Cell.ColumnIndex = 1 through 5
Select Case Cell.ColumnIndex
Case 1
If Asc(Cell.Range.Text) <> 13 Then strPartNumber = Left(Cell.Range.Text, Len(Cell.Range.Text) - 2)
Case 2
If Asc(Cell.Range.Text) <> 13 Then strCAGE = Left(Cell.Range.Text, Len(Cell.Range.Text) - 2)
Case 3
If Asc(Cell.Range.Text) <> 13 Then strNomenclature = Left(Cell.Range.Text, Len(Cell.Range.Text) - 2)
Case 4
If Asc(Cell.Range.Text) <> 13 Then datStart = CDate(Left(Cell.Range.Text, Len(Cell.Range.Text) - 2))
Case 5
If Asc(Cell.Range.Text) <> 13 Then datEnd = CDate(Left(Cell.Range.Text, Len(Cell.Range.Text) - 2))
End Select
If strPartNumber <> "" Or _
strCAGE <> "" Or _
strNomenclature <> "" Or _
datStart <> #12:00:00 AM# Or _
datEnd <> #12:00:00 AM# Then bolRowHasData = True
If bolDocHasData = False And bolRowHasData = True Then
bolDocHasData = True
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tblTasks (FundingDocID, TaskName) SELECT " & lngFundingDocID & ", '" & strTaskTitle & "';"
DoCmd.SetWarnings True
lngDocID = DMax("[ID]", "tblTasks")
End If
If bolTableHasData = False Then
If bolRowHasData Then
bolTableHasData = True
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tblTasks (FundingDocID, TaskName, SuperTaskID) SELECT " & lngFundingDocID & ", '" & strMainTask & "', " & lngDocID & ";"
DoCmd.SetWarnings True
lngMainTaskID = DMax("[ID]", "tblTasks")
End If
End If
If bolTableHasData = True Then
If datStart <> #12:00:00 AM# Then
If datMinDate = #12:00:00 AM# Then datMinDate = datStart
If datDocMinDate = #12:00:00 AM# Then datDocMinDate = datStart
If datMinDate > datStart Then datMinDate = datStart
If datDocMinDate > datStart Then datDocMinDate = datStart
End If
If datEnd <> #12:00:00 AM# Then
If datMaxDate = #12:00:00 AM# Then datMaxDate = datEnd
If datDocMaxDate = #12:00:00 AM# Then datDocMaxDate = datEnd
If datMaxDate < datEnd Then datMaxDate = datEnd
If datDocMaxDate < datEnd Then datDocMaxDate = datEnd
End If
End If
Next Cell
If bolRowHasData = True Then
strTaskName = strNomenclature & "(Part# " & strPartNumber & " / CAGE " & strCAGE & ")"
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tblTasks (FundingDocID, SuperTaskID, TaskName, StartDate, FinishDate, Duration) SELECT " & lngFundingDocID & ", " & lngMainTaskID & ", '" & strTaskName & "', #" & datStart & "#, #" & datEnd & "#, " & Weekdays(datStart, datEnd) & ";"
DoCmd.SetWarnings True
End If
End If
Next Row
If bolTableHasData = True Then
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE tblTasks SET tblTasks.StartDate = #" & datMinDate & "#, tblTasks.FinishDate = #" & datMaxDate & "#, tblTasks.Duration = " & Weekdays(datMinDate, datMaxDate) & " " & _
"WHERE (((tblTasks.ID)=" & lngMainTaskID & "));"
DoCmd.RunSQL "UPDATE tblTasks SET tblTasks.StartDate = #" & datDocMinDate & "#, tblTasks.FinishDate = #" & datDocMaxDate & "#, tblTasks.Duration = " & Weekdays(datDocMinDate, datDocMaxDate) & " " & _
"WHERE (((tblTasks.ID)=" & lngDocID & "));"
DoCmd.SetWarnings True
End If
End If
End If
Next BM
Exit_Sub:
On Error Resume Next
Set tbl = Nothing
Set BM = Nothing
doc.Close
Set doc = Nothing
Set objwd = Nothing
Exit Sub
Err_Handler:
bolImportFailed = True
Debug.Print Err.Number, Err.Description
Resume Exit_Sub
End Sub