Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 03-06-2013, 08:27 AM
Peter Carter's Avatar
Peter Carter Peter Carter is offline Run a macro on multiple docx. files Windows 8 Run a macro on multiple docx. files Office 2013
Novice
Run a macro on multiple docx. files
 
Join Date: Mar 2013
Posts: 11
Peter Carter is on a distinguished road
Question Run a macro on multiple docx. files

Dose any one know how i can run a macro on multiple docx. files that are located in the same folder.


I need it to open a file run a given macro save and close the file, and move to the next file in the folder.
Reply With Quote
  #2  
Old 03-06-2013, 02:20 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

hi peter,

You could use code like:
Code:
Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName: strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      'Call your other macro or insert its code here
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
For PC macro installation & usage instructions, see: Installing Macros
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 03-08-2013, 07:14 AM
Peter Carter's Avatar
Peter Carter Peter Carter is offline Run a macro on multiple docx. files Windows 8 Run a macro on multiple docx. files Office 2013
Novice
Run a macro on multiple docx. files
 
Join Date: Mar 2013
Posts: 11
Peter Carter is on a distinguished road
Default will it process every file

When you run this macro will it process every docx file in the folder that you direct it to?
Reply With Quote
  #4  
Old 03-08-2013, 01:55 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

I wouldn't have posted it otherwise ...
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #5  
Old 04-09-2013, 08:55 AM
Peter Carter's Avatar
Peter Carter Peter Carter is offline Run a macro on multiple docx. files Windows 8 Run a macro on multiple docx. files Office 2013
Novice
Run a macro on multiple docx. files
 
Join Date: Mar 2013
Posts: 11
Peter Carter is on a distinguished road
Default

Lets say that I have a macro named ChangeFonts how would I get this macro UpdateDocuments to call for the ChangeFonts macro. Where in the code would I place it. I placed it in the place where it said "Call your other macro or insert its code here" but it does not do anything. So I am asking to see just what the code would look like so that I can see what I am doing wrong.
Thank you

Here is the code that I have, when I run it, it will run with and show no errors, however it also does not process The file. Could anyone look at it and tell me what I have wrong.
Code:
Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    'Call your other macro or insert its code here
    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 
    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 
    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.Find.ClearFormatting 
    Selection.Find.Replacement.ClearFormatting 
    With Selection.Find 
      .Text = "~*~" 
      .Replacement.Text = " " 
      .Forward = True 
      .Wrap = wdFindContinue 
      .Format = False 
      .MatchCase = False 
      .MatchWholeWord = False 
      .MatchAllWordForms = False 
      .MatchSoundsLike = False 
      .MatchWildcards = True 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll
    .Close SaveChanges:=True
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Last edited by macropod; 04-09-2013 at 02:43 PM. Reason: Added code tags & formatting, merged posts
Reply With Quote
  #6  
Old 04-09-2013, 02:49 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Aside from the fact you've omitted the 'If strFolder & "" & strFile <> strDocNm Then', which means the macro probably won't run to completion if you store the document containing it in the same folder you want to process, there is nothing inherently wrong with your code. Even so, your Find/Replace part could be greatly streamlined:
Code:
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Text = "["
      .Replacement.Text = " ~"
      .Execute Replace:=wdReplaceAll
      .Text = "]"
      .Replacement.Text = "~"
      .Execute Replace:=wdReplaceAll
      .Text = "~*~"
      .Replacement.Text = " "
      .Execute Replace:=wdReplaceAll
    End With
Are you sure the files are .docx format? By specifying that, no .doc or .docm files will be processed.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #7  
Old 04-10-2013, 06:43 AM
Peter Carter's Avatar
Peter Carter Peter Carter is offline Run a macro on multiple docx. files Windows 8 Run a macro on multiple docx. files Office 2013
Novice
Run a macro on multiple docx. files
 
Join Date: Mar 2013
Posts: 11
Peter Carter is on a distinguished road
Default Works

Paul thank you, I used your streamlined code with the addition of the line ". MatchWildcards = True" just before the end and it worked good. So the full code looked like this:

Code:
Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Text = "["
      .Replacement.Text = " ~"
      .Execute Replace:=wdReplaceAll
      .Text = "]"
      .Replacement.Text = "~"
      .Execute Replace:=wdReplaceAll
      .MatchWildcards = True
      .Text = "~*~"
      .Replacement.Text = " "
      .Execute Replace:=wdReplaceAll
    End With
    .Close SaveChanges:=True
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
What would I need to add to get this code to create a new folder and save the new files in that folder?

Last edited by macropod; 04-10-2013 at 01:50 PM. Reason: Added code tags & formatting
Reply With Quote
  #8  
Old 04-10-2013, 01:57 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

To do that, you would need to change:
.SaveAs2 FileName:="Filepath" & .Name, Fileformat:=wdFormatXMLDocument, AddToRecentFiles:=False
before:
.Close SaveChanges:=False
where Filepath is the fully-qualified path, including the trailing path separator.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #9  
Old 04-11-2013, 06:50 AM
Peter Carter's Avatar
Peter Carter Peter Carter is offline Run a macro on multiple docx. files Windows 8 Run a macro on multiple docx. files Office 2013
Novice
Run a macro on multiple docx. files
 
Join Date: Mar 2013
Posts: 11
Peter Carter is on a distinguished road
Default I may have done it wrong

I may have done it wrong, but it did not work for me could you show me what that finished code should look like?
Reply With Quote
  #10  
Old 04-11-2013, 12:27 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Sorry, I missed the bit about creating a new folder. The additional code I posted won't do that. Indeed, I don't see the benefit of writing code for what should be a once-off exercise that takes a few seconds to do manually. Is there a reason you need to do it in code?
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #11  
Old 04-11-2013, 02:14 PM
Peter Carter's Avatar
Peter Carter Peter Carter is offline Run a macro on multiple docx. files Windows 8 Run a macro on multiple docx. files Office 2013
Novice
Run a macro on multiple docx. files
 
Join Date: Mar 2013
Posts: 11
Peter Carter is on a distinguished road
Default I just seen where someone had it

No, I don't have to have it that way, I just seen where someone had it in their code (I will post their code below), of course it performed another function, it cleaned all metadata from all documents in a folder, and I was thinking it would be useful if I could get my code to do the same thing. Because if there was a problem you could never ruin your original documents.

Here is their code:

Code:
Sub Anonymizer()
' Anonymizer Macro
' Removes meda data in all the docxs in a folder and saves in new folder
Application.ScreenUpdating = False
Dim strInFold As String, strOutFold As String, strFile As String, strOutFile As String, DocSrc As Document
'Call the GetFolder Function to determine the folder to process
strInFold = GetFolder
If strInFold = "" Then Exit Sub
strFile = Dir(strInFold & "\*.doc", vbNormal)
'Check for documents in the folder - exit if none found
If strFile <> "" Then strOutFold = strInFold & "\Output\"
'Test for an existing outpfolder & create one if it doesn't already exist
If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
strFile = Dir(strInFold & "\*.doc", vbNormal)
'Process all documents in the chosen folder
While strFile <> ""
  Set DocSrc = Documents.Open(FileName:=strInFold & "\" & strFile, AddTorecentFiles:=False, Visible:=False)
  With DocSrc
    'remove personal information
    .RemoveDocumentInformation (wdRDIDocumentProperties)
    'String variable for the output filenames
    strOutFile = strOutFold & Split(.Name, ".")(0)
    'Save and close the document
    .SaveAs FileName:=strOutFile
    .Close
  End With
  strFile = Dir()
Wend
Set Rng = Nothing: Set DocSrc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder(Optional Title As String, Optional RootFolder As Variant) As String
On Error Resume Next
GetFolder = CreateObject("Shell.Application").BrowseForFolder(0, Title, 0, RootFolder).Items.Item.Path
End Function
Reply With Quote
  #12  
Old 04-11-2013, 03:56 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

That's actually some code I wrote! See: https://www.msofficeforums.com/word-...documents.html

For your purposes, the macro becomes:
Code:
Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strInFolder As String, strOutFold As String, strFile As String, wdDoc As Document
strInFolder = GetFolder
If strInFolder = "" Then Exit Sub
strFile = Dir(strInFolder & "\*.doc", vbNormal)
'Check for documents in the folder - exit if none found
If strFile <> "" Then strOutFold = strInFolder & "\Output\"
'Test for an existing outpfolder & create one if it doesn't already exist
If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
strFile = Dir(strInFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strInFolder & "\" & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
  With wdDoc
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Text = "["
      .Replacement.Text = " ~"
      .Execute Replace:=wdReplaceAll
      .Text = "]"
      .Replacement.Text = "~"
      .Execute Replace:=wdReplaceAll
      .MatchWildcards = True
      .Text = "~*~"
      .Replacement.Text = " "
      .Execute Replace:=wdReplaceAll
    End With
    'Save and close the document
    .SaveAs FileName:=strOutFold & .Name, AddToRecentFiles:=False
    .Close
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub 
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #13  
Old 04-12-2013, 06:49 AM
Peter Carter's Avatar
Peter Carter Peter Carter is offline Run a macro on multiple docx. files Windows 8 Run a macro on multiple docx. files Office 2013
Novice
Run a macro on multiple docx. files
 
Join Date: Mar 2013
Posts: 11
Peter Carter is on a distinguished road
Default

Works very good, thank you.

What Would I add to get it to also do sub-folders.
Thank you.
Reply With Quote
  #14  
Old 04-24-2013, 05:20 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

It would be nice if you said up-front what it is you want to do. I don't especially enjoy re-writing code because the requirements weren't properly thought through at the outset. This is the second time you've made such a change.

Before your 'UpdateDocuments' sub, insert:
Code:
Dim FSO As Object, oFolder As Object, StrFolds As String
 
Sub Main()
Dim TopLevelFolder As String, TheFolders As Variant, aFolder As Variant, i As Long
TopLevelFolder = GetFolder
StrFolds = vbCr & TopLevelFolder
If TopLevelFolder = "" Then Exit Sub
If FSO Is Nothing Then
  Set FSO = CreateObject("Scripting.FileSystemObject")
End If
'Get the sub-folder structure
Set TheFolders = FSO.GetFolder(TopLevelFolder).SubFolders
For Each aFolder In TheFolders
  RecurseWriteFolderName (aFolder)
Next
'Process the documents in each folder
For i = 1 To UBound(Split(StrFolds, vbCr))
  Call UpdateDocuments(CStr(Split(StrFolds, vbCr)(i)))
Next
End Sub
 
 
Sub RecurseWriteFolderName(aFolder)
Dim SubFolders As Variant, SubFolder As Variant
Set SubFolders = FSO.GetFolder(aFolder).SubFolders
StrFolds = StrFolds & vbCr & CStr(aFolder)
On Error Resume Next
For Each SubFolder In SubFolders
  RecurseWriteFolderName (SubFolder)
Next
End Sub
Change your 'UpdateDocuments' sub's name from:
Sub UpdateDocuments()
to:
Sub UpdateDocuments(oFolder As String)
and change its lines:
strInFolder = GetFolder
If strInFolder = "" Then Exit Sub
to:
strInFolder = oFolder

With the above changes, you now run the 'Main' sub.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #15  
Old 04-25-2013, 09:02 AM
Peter Carter's Avatar
Peter Carter Peter Carter is offline Run a macro on multiple docx. files Windows 8 Run a macro on multiple docx. files Office 2013
Novice
Run a macro on multiple docx. files
 
Join Date: Mar 2013
Posts: 11
Peter Carter is on a distinguished road
Thumbs up It worked good

The code worked very well, here it is redone, for anyone who may need it.

Code:
Dim FSO As Object, oFolder As Object, StrFolds As String
 
Sub Main()
Dim TopLevelFolder As String, TheFolders As Variant, aFolder As Variant, i As Long
TopLevelFolder = GetFolder
If TopLevelFolder = "" Then Exit Sub
StrFolds = vbCr & TopLevelFolder
If FSO Is Nothing Then
  Set FSO = CreateObject("Scripting.FileSystemObject")
End If
'Get the sub-folder structure
Set TheFolders = FSO.GetFolder(TopLevelFolder).SubFolders
For Each aFolder In TheFolders
  RecurseWriteFolderName (aFolder)
Next
'Process the documents in each folder
For i = 1 To UBound(Split(StrFolds, vbCr))
  Call UpdateDocuments(CStr(Split(StrFolds, vbCr)(i)))
Next
End Sub
 
 
Sub RecurseWriteFolderName(aFolder)
Dim SubFolders As Variant, SubFolder As Variant
Set SubFolders = FSO.GetFolder(aFolder).SubFolders
StrFolds = StrFolds & vbCr & CStr(aFolder)
On Error Resume Next
For Each SubFolder In SubFolders
  RecurseWriteFolderName (SubFolder)
Next
End Sub


Sub UpdateDocuments(oFolder As String)
Application.ScreenUpdating = False
Dim strInFolder As String, strOutFold As String, strFile As String, wdDoc As Document
strInFolder = oFolder
strFile = Dir(strInFolder & "\*.docx", vbNormal)
'Check for documents in the folder - exit if none found
If strFile <> "" Then strOutFold = strInFolder & "\Output\"
'Test for an existing outpfolder & create one if it doesn't already exist
If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
strFile = Dir(strInFolder & "\*.docx", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strInFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Text = "["
      .Replacement.Text = "~"
      .Execute Replace:=wdReplaceAll
      .Text = "]"
      .Replacement.Text = "~"
      .Execute Replace:=wdReplaceAll
      .MatchWildcards = True
      .Text = "~*~"
      .Replacement.Text = " "
      .Execute Replace:=wdReplaceAll
    End With
    'Save and close the document
    .SaveAs FileName:=strOutFold & .Name, AddToRecentFiles:=False
    .Close
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
Reply With Quote
Reply

Tags
multiple files

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
How to open Docx files? mond_bees Word 12 08-29-2012 03:32 AM
Run a macro on multiple docx. files convert multiple csv files to multiple excel files mit Excel 1 06-14-2011 10:15 AM
Run a macro on multiple docx. files looking for macro for multiple files bolk Word 3 05-03-2011 05:46 AM
Run a macro on multiple docx. files macro to pull data from multiple files psrs0810 Excel 2 10-25-2010 01:49 PM
Icon for docx files Jazz43 Word 2 10-20-2009 08:34 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 01:49 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft