deluzional
12-02-2013, 02:20 PM
Hi All,
I really need help with the code below. I am not sure what I am doing wrong with this macro.
I am using Excel VBA to open Word files in a folder, go in each file and delete a section in each .doc; save and close Word, while creating a log in the .cvs file.
Like, I have a section in each file that need to be remove. So the below is basically trying to open each doc, delete the range of text, save, and close app. This will loop through the files until the last file is done.
Help will be much appreciated.
Option Explicit
Public fso As FileSystemObject
Public Const PathToProts As String = "C:\Test\"
' Start
Public Sub Main()
Set fso = New FileSystemObject
Dim wrdApp As Word.Application, wrdDoc As Word.Document
Dim wrdFil As File, fol As Folder, wrdRng As Word.Range, wrdrngStart As Word.Range, wrdrngEnd As Word.Range, rngToDelete As Word.Range
Dim logFile As Scripting.TextStream
If fso.FolderExists(PathToProts) Then
Set fol = fso.GetFolder(PathToProtocols)
Set wrdApp = CreateObject("word.application")
wrdApp.Visible = True
Set logFile = fso.OpenTextFile("C:\Test\ProtsLog.csv", ForAppending, True)
For Each wrdFil In fol.Files
If Right(wrdFil.Name, 4) = ".doc" Then
Set wrdDoc = wrdApp.Documents.Open(PathToProts & "," & wrdFil.Name)
Set wrdRng = wrdDoc.Content
Set wrdrngStart = wrdRng
With wrdrngStart.Find
.ClearFormatting
.Text = "PLEASE DELETE"
.Execute
End With
If wrdrngStart Is Nothing Then
logFile.WriteLine wrdFil.Name & "," & "Missing text - Start of Please Delete"
GoTo nextLoop
End If
Set wrdrngEnd = wrdDoc.Content
With wrdrngEnd.Find
.ClearFormatting
.Text = "End of PLEASE DELETE"
.Execute
End With
If Not wrdrngEnd Is Nothing Then
Set rngToDelete = wrdDoc.Range(wrdrngStart.Start, wrdrngEnd.End)
rngToDelete.Delete
Else
logFile.WriteLine wrdFil.Name & "," & "Missing text - End of Please Delete"
End If
End If
nextLoop:
wrdApp.Documents.Save
wrdDoc.Close False
Set wrdDoc = Nothing
Set wrdApp = Nothing
Next
End If
MsgBox "Finished"
End Sub
I really need help with the code below. I am not sure what I am doing wrong with this macro.
I am using Excel VBA to open Word files in a folder, go in each file and delete a section in each .doc; save and close Word, while creating a log in the .cvs file.
Like, I have a section in each file that need to be remove. So the below is basically trying to open each doc, delete the range of text, save, and close app. This will loop through the files until the last file is done.
Help will be much appreciated.
Option Explicit
Public fso As FileSystemObject
Public Const PathToProts As String = "C:\Test\"
' Start
Public Sub Main()
Set fso = New FileSystemObject
Dim wrdApp As Word.Application, wrdDoc As Word.Document
Dim wrdFil As File, fol As Folder, wrdRng As Word.Range, wrdrngStart As Word.Range, wrdrngEnd As Word.Range, rngToDelete As Word.Range
Dim logFile As Scripting.TextStream
If fso.FolderExists(PathToProts) Then
Set fol = fso.GetFolder(PathToProtocols)
Set wrdApp = CreateObject("word.application")
wrdApp.Visible = True
Set logFile = fso.OpenTextFile("C:\Test\ProtsLog.csv", ForAppending, True)
For Each wrdFil In fol.Files
If Right(wrdFil.Name, 4) = ".doc" Then
Set wrdDoc = wrdApp.Documents.Open(PathToProts & "," & wrdFil.Name)
Set wrdRng = wrdDoc.Content
Set wrdrngStart = wrdRng
With wrdrngStart.Find
.ClearFormatting
.Text = "PLEASE DELETE"
.Execute
End With
If wrdrngStart Is Nothing Then
logFile.WriteLine wrdFil.Name & "," & "Missing text - Start of Please Delete"
GoTo nextLoop
End If
Set wrdrngEnd = wrdDoc.Content
With wrdrngEnd.Find
.ClearFormatting
.Text = "End of PLEASE DELETE"
.Execute
End With
If Not wrdrngEnd Is Nothing Then
Set rngToDelete = wrdDoc.Range(wrdrngStart.Start, wrdrngEnd.End)
rngToDelete.Delete
Else
logFile.WriteLine wrdFil.Name & "," & "Missing text - End of Please Delete"
End If
End If
nextLoop:
wrdApp.Documents.Save
wrdDoc.Close False
Set wrdDoc = Nothing
Set wrdApp = Nothing
Next
End If
MsgBox "Finished"
End Sub