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
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.
Subscribe to:
Post Comments (Atom)
Hot Topics
-
Objectives To provide detailed information about ListBox Types of ListBox Using ListBox in VBA applications Please read the post till end...
-
Main points about class Class is a template to create objects. Class is user defined data type. Class represents a business entity. Class is...
-
JavaScript was created in 1995 by a programmer named Brendan Eich for Netscape Communications Company. Brendan Eich worked in the same comp...
No comments:
Post a Comment