Thread: Text Insert
View Single Post
 
Old 04-10-2024, 12:53 PM
ranjan ranjan is offline Windows 10 Office 2019
Advanced Beginner
 
Join Date: May 2021
Posts: 80
ranjan is on a distinguished road
Default Text Insert

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