shreeram.maroo wrote:Hi,
I am not getting what to do ........
Hi shreeram.maroo,
I had started a reply as Hans did it all for you, so I will post it anyway, just as an alternative..
First, importantly, I think what Rudi was implying was along the line of what I was suggesting in my long post. That is to say that the main thing being done here is the “getting at” all Files and Sub Folders in a Main Folder. In Rudi’s code then you put what you actually want to be done to a File ( my “Doing Stuff” ) where he indicated
Code: Select all
'...insert any file processing code here...
Correspondingly in any of my codes to
Code: Select all
''''''''Doing Stuff for Each File
' 'Dim wkb As Workbook: Set wkb = Workbooks.Open(oFile) ' For Excel ! '
' (...insert any file processing code here )
'
' 'wkb.Close SaveChanges:=True ‚ For Excel !
''''''''End Doing Stuff for Each File
_...................................
I know virtually nothing about Word VBA, but to have a go at the code for your “Doing” stuff. I…….
_1 ) Started running a macro recording.
_2) I Opened any spare document which had some “Poo” in it. ( Which is of course is best removed ! )
_3 ) Hit Ctrl A to select the whole Text
_4 ) Used the Find Replace Dialogue Box thing to replace any “Poo” with “xxx” for the whole document
_ 5) Closed the File
_6 ) Stopped running the recorder.
I got this code from doing all that:.
Code: Select all
Sub Makro6()
'
' Makro6 Makro
'
'
Documents.Open FileName:="AFileWithSomePooIn.docx", ConfirmConversions:= _
False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", _
DocumentDirection:=wdLeftToRight
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "poo"
.Replacement.Text = "xxx"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveWindow.Close
End Sub
_...............................................
So I played around a bit taking bits out of that code, ( and occasionally putting them beck in if the code then did not then work!! )…… I also did a mod or two based on what I Learnt from the last answer in a similar Question I asked here……………
http://www.eileenslounge.com/viewtopic.php?f=26&t=22603" onclick="window.open(this.href);return false;
_
~~~~~~….. and so eventually I simplified it to this shortened code version
Sub MakroModPodPooxxx()
Code: Select all
Sub MakroModPodPooxxx()
Documents.Open FileName:="AFileWithSomePooIn.docx"
Selection.WholeStory 'Ctrl A
With Selection.Find 'I think this sort of calls up a shortened default version of the Find Replace Dialogue Box
.Text = "poo"
.Replacement.Text = "xxx"
.Execute Replace:=wdReplaceAll
End With
ActiveWindow.Close SaveChanges:=True 'SaveChanges:=True stops me being asked if I want to save Document
End Sub ' MakroModPodPooxxx()
_.................................................
Hans code is a lot neater, ( in the main Routine his “Doing stuff” is just one line calling a second Routine,
Sub ProcessFile ( ). In that second routine he wrote directly a more efficient code, - but which you will see his
Sub ProcessFile(strFile As String)
has some similarities to my
Sub MakroModPodPooxxx()
_........................................................
Hope that helps to explain it all a bit. ( Once you know the answer you see you were really asking for a
Short Word VBA code. The rest was a straight forward application of the codes here to loop through all folders and sub Folders ). So your approach should be to get a short code working on one file such that it is doing the stuff you want. Then you stick it in at the approriate place in the main Code which "
loops through all Files in all Folders and Sub Folders in a Main Folder"
Alan
P.s. So for completeness here is a full single Code doing what you want. ( But I recommend you hhave a go at writng one yourself. All the info you need is in this Thread ! )
Anyway, My start point was my version of Rudi’s Queue code. ( I like this as an alternative to the Recursion type codes most people use, as there is no need for an initial Routine to call the Recursion Routine ( Recursion being the idea of a Routine calling itself ) ).
- So the Queue code makes it a lot less bother with not having to pass over lots of needed variables in the ( Signature line ( ByVal this, ByVal that etc… ) ) of the called Routine and at the Call-ing line in the Main Routine. ) . Because of not having to pass over so many variables it is easy to stick the two Input Boxes like wot Rudi did originally. So I did. They ask you for the strings you want to Find and Replace. ( I have simply commented out (
'+ ) bits of my original code which are not relevant to the “stuff” you want to do )
Code:
Sub ReplaceInAllSubFoldersQingWordMakroModPodPooxxx ()
' This code should be ran from Word.
Code: Select all
Option Explicit
' Rudi http://www.eileenslounge.com/viewtopic.php?f=27&t=22499#p177221 Hans http://www.eileenslounge.com/viewtopic.php?f=27&t=22499#p177241
' This code should be ran from Word.
Sub ReplaceInAllSubFoldersQingWordMakroModPodPooxxx()
'+ Rem 1Q) Some Worksheets and General Variables Info '+ NOT RELEVANT FOR WORD WONK
'+ Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets.Item(1) 'Worksheets("RudyMSRQueue") 'CHANGE TO SUIT YOUR WORKSHEET
'+ Dim strDefPath As String: Let strDefPath = ThisWorkbook.Path ' Any Path to Folder to test this code! here we simply use the Path where the File with this code in is
'+ Dim strDefFldr As String: Let strDefFldr = "EileensFldr" 'Just for an initial suggestion
Rem 1.5Q) Rudi Input Boxes
Dim strFind As String, strReplace As String
Let strFind = InputBox(prompt:="Enter text to find", Title:="Find", Default:="poo") '
If strFind = "" Then
MsgBox "No find text specified!", vbExclamation
Exit Sub
End If
Let strReplace = InputBox(prompt:="Enter replacement text", Title:="Replace", Default:="xxx")
If strFind = "" Then
MsgBox "No replace text specified!", vbExclamation
Exit Sub
End If
Rem 2Q) Get Folder Info ( Using VBA Application.FileDialog(msoFileDialogFolderPicker) Property )
Dim strWB As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Folder Select "
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
Let strWB = .SelectedItems(1) & "\"
End With
Rem 3Q) Microsoft Scripting Runtime Library
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject") 'Late Binding
'Dim FSO As Scripting.FileSystemObject 'Early Binding alternative activate a reference to the Microsoft Scripting Runtime Library in the Tools > References menu of VBE.
'Set FSO = New Scripting.FileSystemObject
Rem 4Q)'Some variables for Positon of Things
'+ Dim rCnt As Long, clmLvl As Long: Let clmLvl = 1: Let rCnt = -1 'rowCount is genaraly increase for a new entry, Column "level" is intended to give an indication of how far down ( to he right ) you are in the Folder chain. Ste to 1 for the first mainn Initial Folder.
'+ Dim CurrentLvlCnt As Long: CurrentLvlCnt = 1 'Count of the Number of Folders in the Folder level currently being run through.
'+ Dim NxtLvlCnt As Long 'Count of the Number of Folders in the next level
Dim queue As Collection
Set queue = New Collection
queue.Add FSO.GetFolder(strWB) 'Main Folder Put at position 1 of Queue'''''
'+ Dim celTL As Range: Set celTL = ws.Range("A1") 'Top left of where Listing should go
'Application.ScreenUpdating = False
Rem 5Q) Main loop. Do While Queue is not Empty effectivelly goes through all Folders
Dim oFile As Object, oFolder As Object, oSubfolder As Object
'Dim oFile As File, oFolder As Folder, oSubfolder As Folder 'For Early Binding
Do While queue.Count > 0 'Main Loop. Does as many times as there are things ( Folders here ) stacked in the Queue========
Set oFolder = queue(1) 'Next Folder .... effectively
queue.Remove 1 'de-queue'......"taken" from start of Queue. ( Actually it is assigned to a variable, then removed from the Queue, which probably just has the Pointer to it.
'+ CurrentLvlCnt = CurrentLvlCnt - 1 'de-the count for numbers in in this current Folder level
''''''''Doing Stuff For the Folder
'+ rCnt = rCnt + 2 'Move on a line and a spare Line for every Folder Entry
'+ celTL.Cells(rCnt, 1).Value = oFolder.Path: celTL.Cells(rCnt, clmLvl).Offset(0, 1).Value = oFolder.Name 'Cell poroperty of Top Left Cell Range Object uset to position output.
''''''''End Doing Stuff for each Folder
'5Qa) Add any Sub Folders from current Folder at end of queue
For Each oSubfolder In oFolder.SubFolders 'For as many ( if any ) Sub Folders In the Current Folder
queue.Add oSubfolder 'en-queue.. add the Sub Folder on at the end of the Queue
'+ NxtLvlCnt = NxtLvlCnt + 1 'en-the count of the Folders in the next Level..Increase our count of the Folders in the Next folder level
Next oSubfolder
'5b) Doing Stuff for every file in current folder
For Each oFile In oFolder.Files
'''''''Doing Stuff for Each File here
'Sub MakroModPodPooxxx()
On Error GoTo ErrHdlr 'In case problem opening file for example
'Set wbk = Workbooks.Open(oFile) ' For Excel
Documents.Open FileName:=oFile.Path '"AFileWithSomePooIn.docx"
Selection.WholeStory 'Ctrl A
With Selection.Find 'I think this sort of calls up a shortened default version of the Find Replace Dialogue Box
.Text = "" & strFind & ""
.Replacement.Text = "" & strReplace & ""
.Execute Replace:=wdReplaceAll
End With
ActiveWindow.Close SaveChanges:=True 'SaveChanges:=True stops me being asked if I want to save Document
'End Sub ' MakroModPodPooxxx()
'+ If InStr(1, oFile.Name, ".xls") > 0 Then 'Option to select only if .xls ( or .xlsx or .xlsm ) type files
'+ rCnt = rCnt + 1
'+ celTL.Cells(rCnt, clmLvl).Offset(0, 1).Value = oFile.Name
'wbk.Close SaveChanges:=True ' For Excel
'+ Else: End If
'''''''End Doing Stuff for Each File
NxtoFile: Next oFile ' Spring Point after error handler so as to go on to next File after the File action that errored
'+ '5Qc) should we have reached the end of the current level of Folders, we reset the level Column for output, and make the new Current Folders in Folder level Count equel to the next one, as we go ion now to Folders from the next level.
'+ If CurrentLvlCnt = 0 Then
'+ clmLvl = clmLvl + 1 'Set column position 1 to the left "down" the Folder Level Chain.
'+ Let CurrentLvlCnt = NxtLvlCnt 'So the current Folder Level count of Folders becomes that last counted.
'+ NxtLvlCnt = 0 'Next level of Folders currently are not in the Queue. This will be re counted for the next Folders as Sub Folders are added to the back of the Queue
'+ Else
'+ End If
Loop 'queue.Count > 0 main loop for all Folders=====================================================================
Application.ScreenUpdating = True
MsgBox "All Excel Files processed", vbInformation
'+ ws.Columns("A:H").AutoFit
Exit Sub 'Normal End for no Erriors
Rem 6) 'Error handler section just put here for convenience
ErrHdlr: 'Hopefully we know why we are here, and after informing can continue ( to next file )
MsgBox prompt:="Error " & Err.Description & " with File " & oFile.Path & ""
On Error GoTo -1 'This needs to be done to reset the VBA exceptional error state of being. Otherwise VBA "thinks"" Errors are being handeled and will not respond again to the Error handler.
On Error GoTo 0 ' Swiches off the current error handler. I do not really need to do this. But it is good practice so the error handler is only in place at the point where i next am expecting an error
GoTo NxtoFile
End Sub
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also