I have written a VBA Sub (below) that is supposed to open all of the .docx and/or .xlsx files in a given directory, perform a find/replace operation, and then overwrite the original files with the new ones. This works as intended every-other-time it is run for a .xlsx file, and throws the error "Method 'Sheets' of object '_Global' failed" every other time. This is my first attempt at programming in VBA, so there is probably a very simple answer that I just cannot see. It breaks on the line of code: "For i = 1 To oWB.Sheets.Count"
Thanks for looking
Option Explicit
Public SearchPhrase As String
Public ReplacePhrase As String
Sub StringReplacer()
Dim fd As FileDialog
Dim PathOfSelectedFolder As String
Dim SelectedFolder
Dim SelectedFolderTemp
Dim MyPath As FileDialog
Dim fs
Dim ExtraSlash As String
ExtraSlash = "\"
Dim MyFile
Dim rngTemp As Range
Dim MinExtensionX As String
Dim arr() As Variant
Dim lngLoc As Variant
Dim oExcel As New Excel.Application
Dim oWB As Excel.Workbook
Dim ws As Worksheet
Dim i As Integer
Dim doc As String
Dim xls As String
Dim redlines As String
'get desired file extensions from checkboxes in GUI and put them into an array
doc = ActiveDocument.FormFields("CKdocx").CheckBox.Value
If doc = True Then
doc = "docx"
Else
doc = " "
End If
xls = ActiveDocument.FormFields("CKxlsx").CheckBox.Value
If xls = True Then
xls = "xlsx"
Else
xls = " "
End If
arr = Array(doc, xls)
'set redlines variable from redlines checkbox in GUI
redlines = ActiveDocument.FormFields("CKredlines").CheckBox.Value
'Prepare to open a modal window, where a folder is selected
Set MyPath = Application.FileDialog(msoFileDialogFolderPicker)
With MyPath
'Open modal window
.AllowMultiSelect = False
If .Show Then
'The user has selected a folder
'Loop through the chosen folder
For Each SelectedFolder In .SelectedItems
'record name of the selected folder
PathOfSelectedFolder = SelectedFolder & ExtraSlash
Set fs = CreateObject("Scripting.FileSystemObject")
Set SelectedFolderTemp = fs.GetFolder(PathOfSelectedFolder)
'Loop through the files in the selected folder
For Each MyFile In SelectedFolderTemp.Files
'grab extension of file
MinExtensionX = Mid(MyFile.Name, InStrRev(MyFile.Name, ".") + 1)
'check to see if extension of the file is in the accepible list
If IsInArray(MinExtensionX, arr) Then
If MinExtensionX = "docx" Then
'Open the Document (.docx)
Documents.Open FileName:=PathOfSelectedFolder & MyFile.Name
'turn off "track changes" if that option was selected
If redlines = True Then
ActiveDocument.TrackRevisions = False
ActiveDocument.Revisions.AcceptAll
End If
'replace all keyphrases (.docx)
Set rngTemp = ActiveDocument.Content
With rngTemp.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.Execute FindText:=SearchPhrase, ReplaceWith:=ReplacePhrase, Replace:=wdReplaceAll
End With
'save and close the document (.docx)
Application.DisplayAlerts = False
ActiveDocument.SaveAs FileName:=PathOfSelectedFolder & MyFile.Name
ActiveDocument.Close
Application.DisplayAlerts = True
End If
If MinExtensionX = "xlsx" Then
'open the document (.xlsx)
oExcel.Visible = True
Set oWB = oExcel.Workbooks.Add(PathOfSelectedFolder & MyFile.Name)
oWB.Activate
'replace all keyphrases sheet by sheet(.xslx)
For i = 1 To oWB.Sheets.Count
Sheets(i).Activate
ActiveSheet.Cells.Replace What:=SearchPhrase, Replacement:=ReplacePhrase, LookAt:=xlPart, MatchCase:=False
Next i
'save and close the document (.xslx)
Application.DisplayAlerts = False
oWB.SaveAs FileName:=PathOfSelectedFolder & MyFile.Name
oWB.Close
Application.DisplayAlerts = True
End If
End If
Next
Next
End If
End With
'close teh excel application and clean up
oExcel.Quit
Set oExcel = Nothing
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
The problem is with this line: Sheets(i).Activate
Replace with oWB.Sheets.Activate
Because of other problems you will run into, I rewrote your entire if statement for ".xlsx" files with all the right references. I also added long winded comments to explain why I changed it:
If MinExtensionX = "xlsx" Then
'open the document (.xlsx)
oExcel.Visible = True
Set oWB = oExcel.Workbooks.Add(PathOfSelectedFolder & MyFile.Name)
oWB.Activate
'replace all keyphrases sheet by sheet(.xslx)
For i = 1 To oWB.Sheets.Count
oWB.Sheets(i).Activate 'Must provide the workbook or Sheets() fails
oWB.ActiveSheet.Cells.Replace What:=SearchPhrase, Replacement:=ReplacePhrase, LookAt:=xlPart, MatchCase:=False 'Must provide the workbook or tries to find activesheet in calling application.
Next i
'save and close the document (.xslx)
oExcel.DisplayAlerts = False 'Using Application instead of oExcel affects calling app instead of Excel
oWB.SaveAs Filename:=PathOfSelectedFolder & MyFile.Name
oWB.Close
oExcel.DisplayAlerts = True 'Using Application instead of oExcel affects calling app instead of Excel
End If
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With