Thursday, January 16, 2025

VBA Word - Process all Word documents of a folder, Delete specific lines

The following VBA code processes all Word documents of a folder one by one. It deletes specific lines which contain some specific texts.
Option Explicit

Sub ProcessFiles()
    Dim FSO As Object
    Dim objFldr As Object
    Dim objFyle As Object
    Dim strFileExtension As String
    Dim appWord As Object
    Dim doc As Object
    
    ' Initialize FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set objFldr = GetFolder()
    
    If objFldr Is Nothing Then Exit Sub ' Exit if no folder is selected

    ' Initialize Word Application
    Set appWord = CreateObject("Word.Application")
    appWord.Visible = True
    
    ' Process each file in the selected folder
    For Each objFyle In objFldr.Files
        strFileExtension = FSO.GetExtensionName(objFyle.Path)
        If LCase(strFileExtension) = "docx" Or LCase(strFileExtension) = "doc" Then
            ' Open the Word document
            Set doc = appWord.Documents.Open(objFyle.Path)
            doc.Activate
            
            ' Apply table style
            Call TableGridDesignMacro
            
            ' Delete specified lines
            Call DeleteLineBeforeAndContainingCopyCode(doc, "You said:")
            Call DeleteLineBeforeAndContainingCopyCode(doc, "Copy code")
            Call DeleteLineBeforeAndContainingCopyCode(doc, "ChatGPT")
            
            ' Save and close the document
            doc.Save
            doc.Close SaveChanges:=True
            Set doc = Nothing
        End If
    Next
    
    ' Quit Word Application
    appWord.Quit
    Set appWord = Nothing
    Set FSO = Nothing
End Sub

Sub DeleteLineBeforeAndContainingCopyCode(doc As Object, strText As String)
    Dim findRange As Range
    Dim deleteRange As Range

    ' Start from the end of the document
    Set findRange = doc.Content
    findRange.Start = findRange.End
    
    ' Search for the text and delete lines
    Do While findRange.Find.Execute(FindText:=strText, Forward:=False, Wrap:=wdFindStop)
        ' Create a range for the current line
        Set deleteRange = findRange.Paragraphs(1).Range
        
        ' Include the line above if it exists
        If deleteRange.Start > doc.Content.Start Then
            deleteRange.Start = deleteRange.Paragraphs(1).Previous.Range.Start
        End If
        
        ' Delete the range
        deleteRange.Delete
    Loop
End Sub

Function GetFolder() As Object
    Dim FSO As Object
    Dim strFolderPath As String
    Dim objFldr As Object

    ' Create a FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    ' Use FileDialog to let the user select a folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count <> 1 Then Exit Function ' Exit if no folder is selected
        strFolderPath = .SelectedItems.Item(1)
    End With
    
    ' Get the selected folder
    Set objFldr = FSO.GetFolder(strFolderPath)
    
    ' Check if the folder contains files
    If objFldr.Files.Count < 1 Then
        MsgBox "No files found in the selected folder.", vbInformation
        Exit Function
    End If
    
    ' Return the folder object
    Set GetFolder = objFldr
    Set FSO = Nothing
End Function

Sub TableGridDesignMacro()
    Dim tbl As Table
    ' Apply "Table Grid" style to all tables in the document
    For Each tbl In ActiveDocument.Tables
        tbl.Style = "Table Grid"
    Next
End Sub

No comments:

Post a Comment

Hot Topics