Loop Macro to Edit Date

damaniam · #1 11-25-2013, 11:44 AM

Utilized the forums before but never posted. I've done some excel macros but not certain of the subtle difference between the two. So here's the scenario.

I have a folder that contains about 100 word documents. I'd like the macro to go to this folder select the first file, open it, and search for the ending dates of any month (ie January 31, February 28, March 31...etc), and change it to a specified ending (ex November 30). The specifying process can be handled either through a msg box or through manually editing one line of the code monthly. I'm ok with either. After the macro has opened and edited the document I'd like it printed in adobe to a specified directory. After its done all that I would like the macro to loop on to the next file in the folder containing the word documents. Sorry if this sounds like someone with a hand out, I'm in a bind and its the best way I know to explain my dilemma.

Here is a sample of what I recorded. It is the find and replace portion. The problem I'd like to work around is having one line be edited that would removed the need to place in "Done" for every occurrence. From there its a looping and printing macro and I'm not certain of how to do that in word.

Thanks in Advance

Code:

Sub Macro3()
 '
 ' Macro3 Macro
 '
 '
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "January 31"
    .Replacement.Text = "Done"
    .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 = "February 28"
    .Replacement.Text = "Done"
    .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 = "March 31"
    .Replacement.Text = "Done"
    .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 = "April 30"
    .Replacement.Text = "Done"
    .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 = "May 31"
    .Replacement.Text = "Done"
    .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 = "June 30"
    .Replacement.Text = "Done"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
    .Text = "July 31"
    .Replacement.Text = "Done"
    .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 = "August 31"
    .Replacement.Text = "Done"
    .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 = "September 30"
    .Replacement.Text = "Done"
    .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 = "October 31"
    .Replacement.Text = "Done"
    .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 = "November 30"
    .Replacement.Text = "Done"
    .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 = "December 31"
    .Replacement.Text = "Done"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

macropod · #2 11-26-2013, 12:29 AM

Do you have the years to go with the dates, or are we to assume February 28 & 29 are both month ends?

damaniam · #3 11-26-2013, 06:43 AM

It will be 2013 for a couple of month. In short it always works out that I am trying to replace the whatever date is on the document with the last day of the previous month.

macropod · #4 11-26-2013, 02:00 PM

For a simple replacement of the last day of the month with text of your choice, you could use code like:

Code:

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document, StrRep As String
strFolder = GetFolder
If strFolder = "" Then Exit Sub
StrRep = InputBox("What is the replacement text?")
strFile = Dir(strFolder & "\*.doc", 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 = wdFindStop
      .Format = False
      .MatchWildcards = True
      .Replacement.Text = StrRep
      .Text = "[ADJMO][abceghlmnorstuy]{2,7} 31"
      .Execute Replace:=wdReplaceAll
      .Text = "February 2[89]"
      .Execute Replace:=wdReplaceAll
      .Text = "[AJSN][beilmnoprtuv]{4,8} 30"
      .Execute Replace:=wdReplaceAll
    End With
    .ExportAsFixedFormat OutputFileName:="Somefolder\" & Left(strFile, InStrRev(strFile, ".")) & "pdf", _
      ExportFormat:=wdExportFormatPDF, OptimizeFor:=wdExportOptimizeForPrint
    .Close SaveChanges:=False
  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

The macro includes its own folder browser, so all you need to do is to select the folder to be processed. All the processed documents be saved as PDFs in that folder, without changing the originals.

However, you now say:

Quote:

I am trying to replace the whatever date is on the document with the last day of the previous month

so it's not clear whether you're trying to replace whatever:
(a) month ends; or
(b) dates anywhere within a month,
the code finds with whatever happens to be the last day of the:
(c) preceding month; or
(d) month prior to when the code is run.
It's quite easy to code for either (a) or (b) and for (d), but (c) would require some more elaborate code.

PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab. That way, your code can be displayed with a proper structure, as per the above.

damaniam · #5 12-03-2013, 06:12 AM

Thanks for the info on the code tags.

The document may contain the last day of any month, but I would like it to always change whatever it finds to the last day of the previous month. For example, today is 12-3-13 and there is 2 documents in the folder. One says "May 31, 2013" and the other says "September 30, 2013", I'd like the macro to change these dates to November 30, 2013 (November 30th being the last day of the month prior today).

macropod · #6 12-03-2013, 02:54 PM

So the dates you're updating do have years? Always? This is important for updates that involve resetting January 2014 to December 2013, for example. It'll also be important for updating, say, May 2013 to any month in 2014.

damaniam · #7 12-04-2013, 09:27 AM

Yes, the date will always include the year as well. Sorry for the lack of clarification.
Also the format is November 30, 2013 for example. Also if it helps, these documents were all created this year so they'd have only month ending dates from 2013.

macropod · #8 12-04-2013, 01:01 PM

Try changing:
StrRep = InputBox("What is the replacement text?")
to:
StrRep = Format(DateAdd("d", -1, CDate(Month(Now()) & "/1/" & Year(Now()))), "MMMM D, YYYY")
and, at the end of each '.Text = ' line, before the final double quotes, insert:
, [12][0-9]{3}

damaniam · #9 12-04-2013, 01:32 PM

At the risk of sounding dumb, where in the code do I tell the macro which folder contains my documents?

macropod · #10 12-04-2013, 01:38 PM

Quote:

Originally Posted by damaniam

At the risk of sounding dumb, where in the code do I tell the macro which folder contains my documents?

If you re-read post #4, especially the first para after the code block, all is explained.

damaniam · #11 12-04-2013, 01:53 PM

Ok well in that case it was a dumb question.

The macro appears to have a bit of quirky behavior. When I run it I get back a run-time error '-2147468259 (800004005)': This file is in use by another application or user.

File is on my desktop and all other windows are closed.

Also the macro seems to be changing more than just the text. It removes the border around the page. I've attached a .doc and a .pdf so you can see a comparison of beginning and end product.

macropod · #12 12-05-2013, 08:28 AM

I've just run the following test macro on the document you uploaded:

Code:

Sub Test()
Dim StrRep As String, wdDoc As Document
StrRep = Format(DateAdd("d", -1, CDate(Month(Now()) & "/1/" & Year(Now()))), "MMMM D, YYYY")
Set wdDoc = ActiveDocument
  With wdDoc
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchWildcards = True
      .Replacement.Text = StrRep
      .Text = "[ADJMO][abceghlmnorstuy]{2,7} 31, [12][0-9]{3}"
      .Execute Replace:=wdReplaceAll
      .Text = "February 2[89], [12][0-9]{3}"
      .Execute Replace:=wdReplaceAll
      .Text = "[AJSN][beilmnoprtuv]{4,8} 30, [12][0-9]{3}"
      .Execute Replace:=wdReplaceAll
    End With
    .ExportAsFixedFormat OutputFileName:="C:\Users\" & Environ("UserName") & "\Documents\Test.pdf", _
      ExportFormat:=wdExportFormatPDF, OptimizeFor:=wdExportOptimizeForPrint
  End With
End Sub

and produced the attached pdf. The date is wrong, but that's because my regional settings aren't configured for US dates. As you can see, there's no issue with the borders.

As for the run-time error, that suggests you or another user already had open the document the code was trying to open. I trust you weren't trying to open the one you were running the macro from (i.e. don't save it to the folder you're trying to process).

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro for tomorrow's Date	tchase01	Word VBA	3	03-01-2012 04:03 PM
Macro to loop in Word	Yamaha Rider	Word VBA	2	02-07-2012 05:33 PM
WORD Macro - import picture - resize - position - page break - loop	Nano07	Word VBA	2	11-02-2011 05:14 AM
Macro to loop in subfolders, change links, export xml data	Catalin.B	Excel Programming	2	09-08-2011 11:37 PM
'Last edit date'	markg2	Word	3	12-26-2010 04:27 PM