Opening and closing all excel files in a directory structure

Dineesh answered a question for me yesterday that allowed me to search through all excel files in a subfolder and replace a piece of text - this worked brilliantly.

What I could now do with though is a very similar piece of code to Dineesh's original one to open, save and close all excel files in a directory structure - including subdirectories - I am sure this is only a minor amendment but my vb isn't up to it I'm afraid (I'll put it on my to do list).

I have attached Dineesh's original code below - I don't need the search and replace in this second piece of code though.

thanks

Joy
Dim fso, folder, files, NewsFile,sFolder
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
 
 Set fso = CreateObject("Scripting.FileSystemObject")
 sFolder = "C:\tests\two"
 Set folder = fso.GetFolder(sFolder)
 Set files = folder.Files
 
 For each folderIdx In files
if right(folderIdx,4) = ".xls" then
 
Set objWorkbook = objExcel.Workbooks.Open(folderIdx)
Set objWorksheet = objWorkbook.Worksheets(1)
 
Set objRange = objWorksheet.UsedRange
 
objRange.Replace "oldurl.com", "new url"
objWorkbook.Save
objWorkbook.close true
end if
Next

Open in new window

joypmorAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

 
TakedaTCommented:
Give this code a try.
Dim fso, folder, files, NewsFile,sFolder
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
 
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "D:\test"
Set folder = fso.GetFolder(sFolder)
 
SearchDir folder,".xls"
 
Function SearchDir(strCurrentDir,strFileExt)
	For Each file In strCurrentDir.Files
		If right(file.name,4) = strFileExt then
			Set objWorkbook = objExcel.Workbooks.Open(file)
			Set objWorksheet = objWorkbook.Worksheets(1)
 			Set objRange = objWorksheet.UsedRange
 			objRange.Replace "oldurl.com", "new url"
			objWorkbook.Save
			objWorkbook.close true
		End If
	Next
	For Each folder In strCurrentDir.SubFolders
		SearchDir folder,strFileExt
	Next
End Function

Open in new window

0

Experts Exchange Solution brought to you by ConnectWise

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
 
joypmorAuthor Commented:
Thanks for this update - sorry I didn't respond earlier - I had been looking regularly and then couldn't for a while.

This works great, although I had to edit it slightly as I don't want to do the search and replace from this script, just the open, save, close (I know it seems a wierd thing to do but there is method in my madness honestly!)

Just one last question, can this be set to run from the current folder rather than hard-coding a start folder?

Thanks again

Joy
Dim fso, folder, files, NewsFile,sFolder
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
 
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "C:\reporting\5_6 reports"
Set folder = fso.GetFolder(sFolder)
 
SearchDir folder,".xls"
 
Function SearchDir(strCurrentDir,strFileExt)
	For Each file In strCurrentDir.Files
		If right(file.name,4) = strFileExt then
			Set objWorkbook = objExcel.Workbooks.Open(file)
 			objWorkbook.Save
			objWorkbook.close true
		End If
	Next
	For Each folder In strCurrentDir.SubFolders
		SearchDir folder,strFileExt
	Next
End Function

Open in new window

0
 
TakedaTCommented:
No prob.  I think this should do it.
Dim fso, folder, files, NewsFile,sFolder
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
 
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
Set folder = fso.GetFolder(sFolder)
 
SearchDir folder,".xls"
 
Function SearchDir(strCurrentDir,strFileExt)
	For Each file In strCurrentDir.Files
		If right(file.name,4) = strFileExt then
			Set objWorkbook = objExcel.Workbooks.Open(file)
 			objWorkbook.Save
			objWorkbook.close true
		End If
	Next
	For Each folder In strCurrentDir.SubFolders
		SearchDir folder,strFileExt
	Next
End Function

Open in new window

0
 
joypmorAuthor Commented:
Hi

Thanks for getting back to me on this.  I'lll try it at work tomorrow because I had a problem running it on my laptop at home - for some reason tried to reinstall MS Office.

I'll let you know how it goes.

Joy
0
 
joypmorAuthor Commented:
I'm so sorry, I thought I had already accepted this!

Works at treat thanks

Joy
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.