Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 06-08-2015, 10:09 AM
bgmsd bgmsd is offline Iterating through tables to find a bookmark Windows 7 32bit Iterating through tables to find a bookmark Office 2010 32bit
Novice
Iterating through tables to find a bookmark
 
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
Reply

Tags
bookmarks, vba word, word 2010



Similar Threads
Thread Thread Starter Forum Replies Last Post
Iterating through tables to find a bookmark Bookmark Not Showing Bookmark RegAudit Word 6 03-16-2015 11:08 PM
Iterating through tables to find a bookmark Find what box in Find and replace limits the length of a search term Hoxton118 Word VBA 7 06-10-2014 05:05 AM
vba to go to next bookmark megatronixs Word VBA 2 06-08-2014 09:53 PM
Iterating through tables to find a bookmark Bad view when using Find and Find & Replace - Word places found string on top line paulkaye Word 4 12-06-2011 11:05 PM
Iterating through tables to find a bookmark VBA to insert Bookmark rockwellsba Word VBA 2 05-31-2011 01:07 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 07:48 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft