![]() |
|
#1
|
||||
|
||||
![]()
Even better
![]() ![]()
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#2
|
|||
|
|||
![]()
Thanks for all of the responses. This definitely helps me to get a better understanding of Word VBA. I am pretty good at Access and Excel VBA, but I have no experience with word until now.
I am still going with the first suggestion. I have already implemented my sub based on that one and it works great. I misspoke when I said looking for a particular bookmark. In reality, what I really needed to do was loop through all of the tables. When I get back to work on Monday I will post my code. Inside the loop I have a select case that looks at the bookmark name. Thanks again, David |
#3
|
|||
|
|||
![]()
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 |
![]() |
Tags |
bookmarks, vba word, word 2010 |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
RegAudit | Word | 6 | 03-16-2015 11:08 PM |
![]() |
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 |
![]() |
paulkaye | Word | 4 | 12-06-2011 11:05 PM |
![]() |
rockwellsba | Word VBA | 2 | 05-31-2011 01:07 AM |