Batch Table Deletions Based on a string.

nmkhan3010 · #1 02-04-2022, 11:15 AM

Hi,

I had copied the below code from the previous posts, it working effectively only when the find string is unique in the document, could you please modify the below code as if the find string is more than one time, then take the first match string as a base to delete the above tables. but the below code is taking the last match case as a base to delete the above tables.

Please add a browse option to delete the unncessary tables in a folder having more than 20 docs.

Please ammend the below changes :

Batch processing of docs in a folder to delete the tables in a folder (Format .rtf, .docx)

ADD:
Dim SourcePath As String
SourcePath = InputBox("PLEASE ENTER PATH", "SOURCE PATH") & ""

Below code is taking last match case as base, please change it to first match case a base to delete the above tables.

Please find the attachment zip folder having more documents and find string is available more than one time.

AAA is available in Table 3 & Table 6 but the below code is deleting a tables above to the table 6, but my need is to delete a tables on first match case which is above to the table 3.

Please find the existing code below:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "AAA"
    .Replacement.Text = ""
    .Format = False
    .Forward = False
    .Wrap = wdFindStop
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
  End With
  Do While .Find.Execute
    If .Information(wdWithInTable) = True Then
      Set Rng = ActiveDocument.Range(0, .Tables(1).Range.Start)
      Do While Rng.Tables.Count > 0
        Rng.Tables(1).Delete
      Loop
      Exit Do
    End If
    .Collapse wdCollapseStart
  Loop
End With
Application.ScreenUpdating = True
End Sub

Thanks in advance.

gmayor · #2 02-04-2022, 11:12 PM

The following should work:

Code:

Sub BatchDelete()
Dim strFile As String
Dim strPath As String
Dim oDoc As Document
Dim iFld As Integer
Dim fDialog As FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Select folder and click OK"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Cancelled By User", , "List Folder Contents"
            Exit Sub
        End If
        strPath = fDialog.SelectedItems.Item(1)
        If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
    End With
    strFile = Dir$(strPath & "*.*")
    While strFile <> ""
        If Right(LCase(strFile), 4) = ".rtf" Or Right(LCase(strFile), 4) = "docx" Then
            Set oDoc = Documents.Open(strPath & strFile)
            DelTables oDoc, "AAA"
            oDoc.Close SaveChanges:=wdSaveChanges
        End If
        strFile = Dir$()
    Wend
lbl_Exit:
    Exit Sub
End Sub

Private Sub DelTables(oDoc As Document, sFind As String)
Dim oTable As Table
Dim lCount As Long
    If oDoc.Tables.Count > 0 Then
        For lCount = oDoc.Tables.Count To 1 Step -1
            If InStr(1, oDoc.Tables(lCount).Range, sFind) > 0 Then
                'Debug.Print oDoc.Name & vbTab & "Table " & lCount
                oDoc.Tables(lCount).Delete
            End If
        Next lCount
    End If
End Sub

nmkhan3010 · #3 02-05-2022, 01:43 PM

Thank You for Help and Support.

I am appreciating and grateful for your help.

Below code is working well but not fulfilling my actual purpose, here code is deleting the find match word tables only.

My Purpose:

If the find string is more than one time in a document, then take the first match string as a base to delete the all ABOVE tables. but the below code is deleting the only match string tables.

EX: AAA is a match string.

There are N no of tables in a document and AAA is found at table 6 and table 9, then the code has to take the first match string as a base to delete all the tables. i.e. Table 1 to tables 5 has to be deleted, because AAA is firstly matched at Table 6.

Suppose if I want to add a Chinese string as a find string shall it accept or not, previously I pasted as Unicode converter code at

.Text = ChrW(32467) & ChrW(31639) & ChrW(22791) & ChrW(20184) & ChrW(37329)

Native Text : 结算备付金

I worked on the Chinese documents and how to write a Chinese find word in VBA mode.
Is there any best way to find strings in Chinese native? Presently am using Unicode converter to find Chinese strings over the document.

Please highlight where I have to paste a Chinese string in this code.

Please review the code once…

Am thankful for your help and need…

gmayor · #4 02-06-2022, 01:56 AM

If you want to delete all the tables up to the one containing the find string, you need a slightly different approach. You will however have to search for the unicode string with English interface which is entered at the top of the code.
If you want to delete the tables up to the table with the first find string (including the table with that string) then:

Code:

Option Explicit

Sub BatchDelete()
Dim sFind As String: sFind = ChrW(32467) & ChrW(31639) & ChrW(22791) & ChrW(20184) & ChrW(37329)
Dim strFile As String
Dim strPath As String
Dim oDoc As Document
Dim iFld As Integer
Dim fDialog As FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Select folder and click OK"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Cancelled By User", , "List Folder Contents"
            Exit Sub
        End If
        strPath = fDialog.SelectedItems.Item(1)
        If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
    End With
    strFile = Dir$(strPath & "*.*")
    While strFile <> ""
        If Right(LCase(strFile), 4) = ".rtf" Or Right(LCase(strFile), 4) = "docx" Then
            Set oDoc = Documents.Open(strPath & strFile)
            DelTables oDoc, sFind
            oDoc.Close SaveChanges:=wdSaveChanges
        End If
        strFile = Dir$()
    Wend
lbl_Exit:
    Exit Sub
End Sub

Private Sub DelTables(oDoc As Document, sFind As String)
Dim lCount As Long, lDel As Long, lTable As Long
    If oDoc.Tables.Count > 0 Then
        For lCount = 1 To oDoc.Tables.Count
            If InStr(1, oDoc.Tables(lCount).Range, sFind) > 0 Then
                Exit For
            End If
        Next lCount
        If lCount > 0 Then
            For lDel = lCount To 1 Step -1
                oDoc.Tables(lDel).Delete
            Next lDel
        End If
    End If
lbl_Exit:
    Exit Sub
End Sub

If you want to retain the table with the first occurrence and delete the preceding tables then change

Code:

If lCount > 0 Then
            For lDel = lCount To 1 Step -1

to

Code:

If lCount > 1 Then
            For lDel = lCount - 1 To 1 Step -1

nmkhan3010 · #5 02-06-2022, 11:43 AM

Above code was working as a charm and its a excellent job that you have done for me.

I really appreciate the effort you put into this work.

I sincerely appreciate your help and once again thanks to you...

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Table Deletions	ranjan	Word Tables	4	09-01-2021 02:58 PM
Table deletions based on a string.	nmkhan3010	Word Tables	3	05-03-2021 08:57 PM
Batch applying a macro to remove Header and Footer using Batch Auto Addin	Edszx	Word VBA	2	05-27-2019 11:16 PM
VBA to provide text string with specific formating based on Drop down list (content control)	MP1989	Word VBA	4	07-30-2018 02:40 AM
Batch change header text which is in a table	marafubu	Word VBA	1	05-16-2018 04:52 AM