Executing a VBA Macro for all files in a folder. 2

[gbent]

Good morning,

I have a list of sixty files all within one folder. I have a VBA macro to do the necessary processing. However, I would like to find a VBA macro that will allow me to point to the folder have the macro execute for each file. If anyone can steer me in the right direction it would be appreciated.

Thank-you
gbent

 

[JerryKlmns]

Take a look at Application.FileSearch in help (also many posts here), to find all the files you need and use a For Next loop to run the macro on each file.

 

[MakeItSo]

Hi Gbent,

you ought to give more details like
- Word, Excel, PPT or...
- Version 2000, XP, 2003, 2007...

One solution e.g. for Word 2000-2003 would be this:

Dim ThePath as String
The Path=Inputbox("Please enter path here")

With Application.FileSearch
    .LookIn = ThePath
    .FileName = "*.rtf"
    .FileType = msoFileTypeWordDocuments
    .SearchSubFolders = False
    .Execute
End With

For i = 1 To Application.FileSearch.FoundFiles.Count
    Documents.Open Application.FileSearch.FoundFiles(i)
    'do your thing here
Next i
'...

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[gbent]

Thanks,

I am using a VBA Macro created in Microsoft Office Word 2003 to process .rtf files that I am viewing in Word.

When you write Next i ' ... does that mean I copy and post my VBA macro here again?

Thanks
Gbent

 

[MakeItSo]

It means you simply use my code above and insert your macro at the position "'do your thing here".
You can leave away the commented out three dots.

In a strange fashion I foresaw exactly what you need...


If you want a more elegant/presentable version instead of an inputbox to enter your path, you can also use a real folder browser popup.

For this, do a keyword search on either
"BrowseForFolder" or "word.dialogs.FileOpen"

Good luck!
Andy

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[fumei]

Or use the Dir function.

"I would like to find a VBA macro that will allow me to point to the folder have the macro execute for each file. "

The question is around the word "me". If it is only you (as the developer) do you require browsing for the folder name? Or do you just need to be able to point to a folder?

If you need to be able to browse, follow MakeItSo's suggestion - do a search for BrowseForFolder.

If you just need to specify, then either FileSearch, or Dir, works.

FileSearch is good, and has more parameters to work with, but Dir works as well.

Sub ProcesFolder()
Dim file
Dim path As String
path = "c:\yadda\moreStuff\"
file = Dir(path & "*.doc)
  Do While file <> ""
     Call EachFile(path & file)
     file = Dir
  Loop
End Sub

Sub EachFile(strPathFileName As String)
   Documents.Open Filename:= strPathFileName
   ' the processing on each file
End Sub

The code goes through each .doc file in the given folder (c:\yadda\moreStuff\ - note the terminating slash) and passes the path and filename to the processing Sub (EachFile).


faq219-2884

Gerry
My paintings and sculpture

 

[gbent]

I do need to be able to browse to the folder. Thank you for catching that detail. I really appreciate all the help from everyone.

gbent

 

[PHV]

Have a look here:
thread707-1414751

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[gbent]

It works, except within my folder I have a file that is returning Run-time error '5854' (String parameter too long). I am not sure what this means and if there is someway to work around it. Any help would be greatly appreciated?

 

[DPlank]

There's a limit to the number of characters you can have in a file path, I think.

255 characters I seem to recall. Will have to have a look and see if I can confirm it...

Cheers,
Dave

"Yes, I'll stop finding bugs in the software - as soon as you stop writing bugs into the software." <-- Me

For all your testing needs: Forum1393

 

[fumei]

It may help if you actually stated what the string (the file name) actually is, that you seem to be getting an error on.

faq219-2884

Gerry
My paintings and sculpture

 

[gbent]

The file name is Kern.rtf. My macro separates the data into COUNTY, NAME, DESCR, LOCATION, NRHP fields. I believe that the problem is occuring within the DESCR because some of these descriptions are long and may actually surpass the 255 character limit.

Thank you for your help.
gbent

 

[MakeItSo]

Wait a sec:
This can't be.

Are you trying to push the data into a database or excel sheet via the macro?
Where exactly does the error occur? Do a debug when the code fails and post the relevant section with the highlighted line (and best the entire block it is located in) here.

I am somehow starting to doubt that this is the length of the full path exceeding 255 chars.
And a string variable can hold 2 Meg characters, so that can't be it either.
Except if you defined something like this

Dim whatever as String(255)

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[gbent]

I start off with .rtf files that are being viewed in Microsoft Word. My macro runs through the file and not only inserts the column names such as COUNTY, DESCR, LOCATION it inserts the character | that allows me to delimit the information into their respective columns in excel.

Here is the block of code where it fails. The line where the code fails has an x at the beginning and end of the line to indicate it to you. I am going to attach my entire macro so you can see where the problem is occuring.

Dim myVariable As String
myVariable = Split(ActiveDocument.Paragraphs(1).Range, vbCr)(0)

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^lNO."
x .Replacement.Text = "^l" & myVariable & "|NO. " x
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory




Here is my full macro:


Sub Macro99()
'
' Macro1 Macro
' Macro recorded 6/9/2008 by GBent
'
' Prompts the user to enter the path to the folder of files to be processed.
Dim ThePath As String
ThePath = InputBox("Please enter path here")

With Application.FileSearch
.LookIn = ThePath
.FileName = "*.rtf"
.FileType = msoFileTypeWordDocuments
.SearchSubFolders = False
.Execute
End With

For i = 1 To Application.FileSearch.FoundFiles.Count
Documents.Open Application.FileSearch.FoundFiles(i)
' 'Runs the processing for the file

Do Until ActiveDocument.Bookmarks("\Sel") = _
ActiveDocument.Bookmarks("\EndOfDoc")
'(Do something)
'Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
'Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "NO."
'.Replacement.Text = "^lNO."
.Font.Bold = True
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.ClearFormatting

If Selection.Find.Found = True Then
'Do something within the found text
With Selection.Find
.Text = "^$"
.Font.Bold = False
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.TypeText Text:="|"
Else
Exit Do
End If
Loop
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "-"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory


'Replaces a ^pNO. with a ^p^lNO. for processing purposes.

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "^pNO."
.Replacement.Text = "^p^lNO."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory

'Replaces the first instance of ^p^lNO. which occurs in Alameda and will insert
'not only a ^p and ^lNO. but also the column headings between them.

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "^p^lNO."
.Replacement.Text = "^pCOUNTY |NAME |DESCR |LOCATION |NRHP ^lNO."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With

'Replaces the carriage return with a pipe in order to allow for Excel delimiting.


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^lLocation:"
.Replacement.Text = "|Location:"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory

'Finds the instances of records that lost a bold N. due to processing
'and replaces the regular text with bold text.


Selection.Find.ClearFormatting
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "^lNO."
.Replacement.Text = "^lNO."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

'Replaces a carriage return with a pipe to allow for a column to be formed for "Listed on the
'National Register of Historic Places:"

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^lListed on the National Register of Historic Places:"
.Replacement.Text = "|Listed on the National Register of Historic Places"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceAll
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With

'Replaces a double carriage return with one carriage to prevent extra columns and incorrect formatting
'within excel.

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "^l^l"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceAll
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With

'Replaces a carriage return, paragraph, and carriage return with a carriage return to ensure
'proper vertical spacing between entries.

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "^l^p^l"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceAll
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With

'Replaces a paragraph and carriage return with a carriage return to again ensure proper
'vertical spacing between entries.


Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p^l"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceAll
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With

'Replaces NO. (regular text) with NO. (bold text) because of the macro's propensity
'to remove bolding.

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "^lNO."
.Replacement.Text = "^lNO."
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "| "
.Replacement.Text = "|"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory

Dim myVariable As String
myVariable = Split(ActiveDocument.Paragraphs(1).Range, vbCr)(0)

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^lNO."
.Replacement.Text = "^l" & myVariable & "|NO. "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory


Next i
End Sub

 

[MakeItSo]

OK, I see.

In Word's Find/Replace you can only replace with a max of 255 characters. So you virtually store the contents of a paragraph in a variable, find "|No." and then try to insert your variable there.
As word cannot handle replacement of more than 255 characters, your code will fail on each pargraph containing more than said 255 characters.

You might want to rethink how you handle that. Take a look at this neat little thingy, it might help you avoid replacements:

 With Selection.Find
        .Text = "^lNO."
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute

[b]    Do While Selection.Find.Found
        Selection.Range.InsertBefore "^l" & myVariable
        Selection.Collapse wdCollapseEnd
        Selection.Find.Execute
    Loop[/b]

Hope this helps you to identify and solve your problem.

Cheers,
Andy

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[gbent]

Andy,

That works great the only thing is this and I don't know if it is possible to solve it. This is an excerpt of what I get when I run the Macro.

NO. 240 MARKLEE'S CABIN SITE |Jacob J. Marklee recorded his land claim of 160 acres on June 23, 1862, in Douglas County, Nevada, but after the boundary survey his claim was in California. During the rush to the Comstock Lode, the town of Markleeville was built upon Marklee's land the Alpine County Courthouse now occupies the site of his cabin.|Location: County Courthouse, Markleeville^lAlpine
NO. 315 KIT CARSON MARKER |On this spot, the summit of the Kit Carson Pass, stood the Kit Carson Tree on which the famous scout Kit Carson inscribed his name in 1844 when he guided the then Captain John C. Frémont, head of a government exploring expedition, over the Sierra Nevada. The original inscription was cut from the tree in 1888 and is now in Sutter's Fort, Sacramento.|Location: On State Hwy 88 (P.M. 5.2), 14.5 mi W of Woodfords^lAlpine

For some reason the carriage return symbol does not seem to be working. I would like to get Alpine|NO. 315 KIT CARSON MARKER . If I am missing a very basic concept here I apologize.

 

[MakeItSo]

Aaaaaaaah, me dummy!
Sorry, my mistake:

If you use "InsertBefore", then of course you insert direct text information. There you cannot use control characters like ^l or ^p or ^m, you have to use the respective code.
Replace ^l with "chr(10)" or "vbLf":

Replace from my code

Selection.Range.InsertBefore "^l" & myVariable

with

Selection.Range.InsertBefore vbLf & myVariable

Sorry for that lapsus..


[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[gbent]

Andy,

Thanks again. I believe we are a step closer. Now I get
Alameda
NO. 1025 UKRANIA, SITE OF AGAPIUS HONCHARENKO FARMSTEAD |“Ukraina” is the site of the farm and burial place of the Ukrainian patriot and exiled orthodox priest Agapius Honcharenko (1832 1916) and his wife Albina. Honcharenko was the first nationally conscious Ukrainian to arrive in the United States. He published the first American newspaper in Russian and Ukrainian languages, The Alaska Herald, from 1868 1872. He wrote the first book for the educational use of Native Alaskans. After moving here from San Francisco in 1873, He continued to publish political literature, which was smuggled into Czarist Russia. Honcharenko was a prominent scholar, humanitarian, and early champion for human rights.|Location: Garin Regional Park, East Bay Regional Park District, San Francisco Bay
Alameda
NO. 1027 PARDEE HOME |The property was built by prominent Oakland pioneer Enoch Pardee, who was a state senator and representative to the Assembly. He was also mayor of Oakland in the 1870’s. Enoch Pardee’s son George also served as Oakland’s mayor but is better known as the “Earthquake” Governor of California, holding office from 1903 through 1907. George Pardee was an important Progressive voice in California Republican politics, but his efforts at reform during his governorship brought on the wrath of the railroads and lost him the nomination of his party for a second term. Pardee went on to work for conservationist causes and to help bring Mokelumne River water to Oakland. The Pardee Dam on that river is named after him.|Location: 672 11th Street, Oakland, CA


It is as if I can't place the variable on the same line in front of NO. Also how would I add the | after "my variable" to allow me to delimit later. I can't use the find and replace for this can I?

 

[MakeItSo]

Hi gbent,

again, the next step is fairly simple.

1.) the paragraph you are inserting still contains a linefeed.

Instead of this

myVariable = Split(ActiveDocument.Paragraphs(1).Range, vbCr)(0)

try that

myVariable = Split(ActiveDocument.Paragraphs(1).Range, [b]vbNewLine[/b])(0)

2.) to insert a delimiter after your variable, simply do this:

Selection.Range.InsertBefore vbLf & myVariable[b] & "|"[/b]

;-)

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[gbent]

Thank-you so much, that works perfectly. You have been an amazing help. Everyone who has replied to this thread has really helped me along.