I want to insert the text before & after the tables based on the below conditions:
Selection of a folder was through browse option...
IF A SEARCH STRING IS AVAILABLE IN MORE THAN ONE TABLE THEN IT SHOULD BE CONSIDERED FIRST OCCURENCE STRING ONLY AND INSERT THE CORRESPONDENCE TEXT TO THE ABOVE AND BELOW OF THE TABLE OUTSIDE STRUCTURE AND IGNORE THE REMAINING AVAILABLE STRINGS IN OTHER TABLES.
CONSIDER ONLY FIRST OCCURENCE STRING & INSERT THE TEXT BASED ON THAT ONLY.
BUT THE BELOW CODE WAS INSERTING CORRESPONDENCE TEXT WHEREEVER THE SEARCH STRING IS AVAIABLE.
Suppose "BBEGINING" is available in the
table 3, table 5, table 6, table 7, table 9 it should be considered first occurence only and ignore the remaining tables.
Here insert "123" is insert at
table 3 only (First occurence & remaining tables has to be ignored) to the above of that table.(outside of the table structure)
if "BBEGINING" is found anywhere in the table then insert "123" to the above of that table.(outside of the table structure)
if "EBEGINING" is found anywhere in the table then insert "456" to the above of that table.(outside of the table structure)
if "IBEGINING" is found anywhere in the table then insert "789" to the above of that table.(outside of the table structure)
if "BENDING" is found anywhere in the table then insert "333" to the below of that table.(outside of the table structure)
if "EENDING" is found anywhere in the table then insert "666" to the below of that table.(outside of the table structure)
if "IENDING" is found anywhere in the table then insert "999" to the below of that table.(outside of the table structure)
Please review the code:
(*) Inserted text only once in a table based on the first occurence only & ignore if it is available in another tables.
(*) Table above & below there is a running text and before inserting a text above or below to the table a double enter has to be entered between the running text and tables (above & below) to insert the text.
Your help is highly coperated.
Below code was running but it want to update with the above criteria.
Code:
Sub InsertTextAroundTables_BATCHFINAL_working_no_issue()
Dim folderPath As String
Dim fileDialog As fileDialog
Dim fileName As String
Dim doc As Document
Dim searchTextAbove As Variant
Dim searchTextBelow As Variant
Dim insertTextAbove As Variant
Dim insertTextBelow As Variant
Dim i As Integer
' Define search strings and corresponding texts to insert
searchTextAbove = Array("BBEGINING", "EBEGINING", "IBEGINING")
searchTextBelow = Array("BENDING", "EENDING", "IENDING")
insertTextAbove = Array("123", "456", "789")
insertTextBelow = Array("333", "666", "999")
' Prompt user to select a folder
Set fileDialog = Application.fileDialog(msoFileDialogFolderPicker)
With fileDialog
.Title = "Select a Folder Containing Word Documents"
If .Show = -1 Then
folderPath = .SelectedItems(1)
Else
MsgBox "No folder selected. Exiting macro.", vbExclamation
Exit Sub
End If
End With
' Loop through each Word document in the folder
fileName = Dir(folderPath & "\*.docx")
Do While fileName <> ""
' Open the document
Set doc = Documents.Open(folderPath & "\" & fileName)
' Loop through each table in the document
For Each tbl In doc.Tables
' Check if there's any running text before the table
If tbl.range.start > doc.range.start Then
' Insert a line break before inserting text above the table
doc.range(tbl.range.start - 1).InsertBefore vbCrLf
End If
' Check if table contains any of the search strings
For i = LBound(searchTextAbove) To UBound(searchTextAbove)
If InStr(1, tbl.range.text, searchTextAbove(i)) > 0 Then
' Insert text above the table
Set rng = tbl.range.Duplicate
rng.Collapse Direction:=wdCollapseStart
rng.MoveStart Unit:=wdCharacter, Count:=-1
rng.InsertBefore insertTextAbove(i) & vbCrLf
Exit For
End If
Next i
For i = LBound(searchTextBelow) To UBound(searchTextBelow)
If InStr(1, tbl.range.text, searchTextBelow(i)) > 0 Then
' Insert text below the table
Set rng = tbl.range.Duplicate
rng.Collapse Direction:=wdCollapseEnd
rng.MoveEnd Unit:=wdCharacter, Count:=1
rng.InsertAfter vbCrLf & insertTextBelow(i)
Exit For
End If
Next i
Next tbl
' Save and close the document
doc.Save
doc.Close
' Get the next file in the folder
fileName = Dir
Loop
' Inform user that the operation is complete
MsgBox "Text has been inserted around tables in all documents in the selected folder.", vbInformation
End Sub