PDA

View Full Version : VBA code for inserting a future date



vbnovice069
08-14-2013, 10:02 AM
I have the below code in a 2007 word document to be able to insert a future date, but the form is protected due to having form fields. I have attached the document I am trying to do this for. I need the date to be inserted in the last form field of the document. I found an example of how to put in code to unprotect and protect again so that the future date macro works, however I don't know where to insert the code to protect the document again. I have the code in to unprotect it. Can someone please tell me what code needs to be put in to protect the document again and where to insert it?

Sub InsertFutureDate()
' Written by Graham Mayor and posted on the word.docmanagement
' newsgroup in March 2000
' Inserts a future date in a document - note that this is not a field
' Some style revisions and error handler by Charles Kenyon
'
Dim Message As String
Dim Mask As String
Dim Title As String
Dim Default As String
Dim Date1 As String
Dim MyValue As Variant
Dim MyText As String
Dim Var1 As String
Dim Var2 As String
Dim Var3 As String
Dim Var4 As String
Dim Var5 As String
Dim Var6 As String
Dim Var7 As String
Dim Var8 As String
'
Mask = "MMMM d, yyyy" ' Set Date format
Default = "7" ' Set default.
Title = "Plus or minus date starting with " & Format(Date, Mask)
Date1 = Format(Date, Mask)
Var1 = "Enter number of days by which to vary above date. " _
& "The number entered will be added to "
Var2 = Format(Date + Default, Mask) ' Today plus default (7)
Var3 = Format(Date - Default, Mask) ' Today minus default (7)
Var4 = ". The default ("
Var5 = ") will produce the date "
Var6 = ". Minus (-"
Var7 = ". Entering '0' (zero) will insert "
Var8 = " (today). Click cancel to quit."
MyText = Var1 & Date1 & Var4 & Default & Var5 & Var2 & Var6 _
& Default & Var5 & Var3 & Var7 & Date1 & Var8
ActiveDocument.Unprotect

'
' Display InputBox and get number of days
GetInput:
MyValue = InputBox(MyText, Title, Default)
'
If MyValue = "" Then
End 'quit subroutine
End If
'
On Error GoTo Oops ' just in case user typed non-number
Selection.InsertBefore Format((Date + MyValue), Mask)
Selection.Collapse (wdCollapseEnd)
End 'End subroutine
'
Oops: ' error handler in case user types something other than a number
'
MsgBox Prompt:="Sorry, only a number will work, please try again.", _
Buttons:=vbExclamation, _
Title:="A number is needed here."
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, _
NoReset:=True


GoTo GetInput

End Sub

gmaxey
08-14-2013, 01:58 PM
You already have code to reprotect the form but it is coming after an End statement so it is never executed.

vbnovice069
08-14-2013, 02:08 PM
You already have code to reprotect the form but it is coming after an End statement so it is never executed.

Where exactly does it need to go? I tried putting it in various places, but I keep getting the error "Sorry, only a number will work. Please try again."

gmaxey
08-14-2013, 08:05 PM
At this point even Graham would admit that your code is a dog's breakfast.

With a protect form and field named "FutureDate" set the following to run on enter:


Sub InsertFutureDate()
Dim oFF As FormField
Dim lngOffset As Long
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect
End If
Set oFF = ActiveDocument.FormFields("FutureDate")
lngOffset = CLng(InputBox("Enter the number of days to offset the current date", "Offset", "7"))
oFF.Result = Date + lngOffset
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End Sub

vbnovice069
08-14-2013, 09:12 PM
This worked! I don't know much about coding obviously. The code I had found was one I found doing a search online. Thank you so much for the help! Just one question though...the comment about the code being a dog's breakfast...what exactly did that mean? Guessing it wasn't anything good though :)

gmaxey
08-14-2013, 09:36 PM
Graham would probably reply:

"Dog's breakfast," British slang for "a complete mess" since at least the 1930s.

vbnovice069
08-14-2013, 09:51 PM
LOL...gotcha. Well I didn't write the code so I won't take offense to it. :) Thanks again for your help!