View Single Post
 
Old 06-08-2015, 10:09 AM
bgmsd bgmsd is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Jun 2015
Posts: 6
bgmsd is on a distinguished road
Default

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
Reply With Quote