I need a Word macro to check, upon file exit or file close, that certain specified text fields (legacy form fields, not content controls) are empty.
I have code that is a pretty intrusive warning box. It is contingent on the user selecting that field, then the macro pops up a warning box either upon entry or exit, as specified in the form field properties menu. I have several fields,"Text1", "text2", then text7 thru 11.
Trouble is, the user MUST select a field. On top of that, the warning box sends them into a death loop before they can close the file. I also have to make a new module for each of fields with the code below.
Perhaps the best solution here is a macro that runs on close and/or exit of the file, which says "Hey you forgot to fill out these fields, they are 'mandatory' so go back and do that please, thanks!".
Sub MustFillIn3()
If ActiveDocument.FormFields("Text2").Result = "" Then
Do
sInFld = InputBox("Request date required, please fill in below.")
Loop While sInFld = ""
ActiveDocument.FormFields("Text2").Result = sInFld
End If
End Sub
Yes, just write the check code in the event handler procedure Document_Close in ThisDocument object, like this
Sub Document_Close()
Dim ff As FormField, sInFld As String, msgShown As Boolean, d As Document, i As Byte
'Dim ffNameDict As New Scripting.Dictionary, ffNameSpecCln As New VBA.Collection
Dim ffNameDict As Object, ffNameSpecCln As New VBA.Collection
Dim arr(7) As String, j As Byte
arr(0) = "location": arr(1) = "request_date": arr(2) = "site"
arr(3) = "UPC": arr(4) = "Current_LOA": arr(5) = "Req_LOA"
arr(6) = "You Lost this One!!"
For i = 1 To 11
Select Case i
Case 1, 2, 7, 8, 9, 10, 11 '"Text1", "text2", then text7 thru 11.
'to a specific name list?
'ffNameSpecCln.Add "Specific Name HERE " & i, "Text" & i
ffNameSpecCln.Add arr(j), "Text" & i
j = j + 1
End Select
Next i
Set ffNameDict = CreateObject("Scripting.Dictionary")
Set d = ActiveDocument
For i = 1 To 11
Select Case i
Case 1, 2, 7, 8, 9, 10, 11 '"Text1", "text2", then text7 thru 11.
'ffNameDict("Text" & i) = "Text" & i
ffNameDict("Text" & i) = ffNameSpecCln.Item("Text" & i)
End Select
Next i
For Each ff In d.FormFields
If ff.Result = "" And ffNameDict.Exists(ff.Name) Then
If Not msgShown Then
MsgBox "Hey you forgot to fill out these fields, they are 'mandatory' so go back and do that please, thanks!", vbExclamation
msgShown = True
End If
Do
' sInFld = InputBox("Request date required, please fill in below." + vbCr + vbCr + _
"@" + ff.Name + " is the current text fields to fill in !")
sInFld = InputBox("Request date required, please fill in below." + vbCr + vbCr + _
"@" + ffNameDict(ff.Name) + " is the current text fields to fill in !")
Loop While sInFld = ""
ff.Result = sInFld
End If
Next ff
d.Save
End Sub
This check sub is triggered when the current document is closed and is not related to whether ff has focus or not (ie. the user Doesn't MUST select a field ).
Option Explicit
Public WithEvents appWord As Word.Application
Private Sub appWord_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
ThisDocument.Document_Close
End Sub
You have to run this sub to Register Event_Handler to Word Application.
Option Explicit
'https://learn.microsoft.com/en-us/office/vba/word/concepts/objects-properties-methods/using-events-with-the-application-object-word
Public X As New app
Public Sub Register_Event_Handler()
Set X.appWord = Word.Application
End Sub
"物件類別模組" = class modules
"模組" = modules
"表單" = user form
"Microsof Word 物件" = Microsof Word object
As for the details, you should adjust them yourself. Try to understand the code I have given you to simulate it. Come back to StackOverflow and ask a new question when you encounter difficulties and problems in the implementation.
I've used the text field to test:
Is this yours?
Option Explicit
Public WithEvents appWord As Word.Application
Private Sub appWord_DocumentBeforeClose(ByVal Doc As Document, Cancel As Boolean)
If Not Doc.Saved Then
If MsgBox("Do you want to save?", vbOKCancel + vbQuestion) = vbOK Then
Doc.Save
Else
Doc.Close wdDoNotSaveChanges
End If
End If
End Sub
Private Sub appWord_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
MS_Word_VBA_to_check_for_empty_text_form_fields_upon_file_close_exit
End Sub
Option Explicit
rem now can be Private, because there is no other place to call this procedure
Private Sub Document_Close()
'MS_Word_VBA_to_check_for_empty_text_form_fields_upon_file_close_exit
End Sub
Private Sub Document_Open()
Register_Event_Handler ' See previous code
End Sub
Sub MS_Word_VBA_to_check_for_empty_text_form_fields_upon_file_close_exit()
Dim ff As FormField, sInFld As String, msgShown As Boolean, d As Document, i As Byte
'Dim ffNameDict As New Scripting.Dictionary, ffNameSpecCln As New VBA.Collection
Dim ffNameDict As Object, ffNameSpecCln As New VBA.Collection
Dim arr(7) As String, j As Byte
arr(0) = "location": arr(1) = "request_date": arr(2) = "site"
arr(3) = "UPC": arr(4) = "Current_LOA": arr(5) = "Req_LOA"
arr(6) = "You Lost this One!!"
For i = 1 To 11
Select Case i
Case 1, 2, 7, 8, 9, 10, 11 '"Text1", "text2", then text7 thru 11.
'to a specific name list?
'ffNameSpecCln.Add "Specific Name HERE " & i, "Text" & i
ffNameSpecCln.Add arr(j), "Text" & i
j = j + 1
End Select
Next i
Set ffNameDict = CreateObject("Scripting.Dictionary")
Set d = ActiveDocument
For i = 1 To 11
Select Case i
Case 1, 2, 7, 8, 9, 10, 11 '"Text1", "text2", then text7 thru 11.
'ffNameDict("Text" & i) = "Text" & i
ffNameDict("Text" & i) = ffNameSpecCln.Item("Text" & i)
End Select
Next i
For Each ff In d.FormFields
If ff.Result = "" And ffNameDict.Exists(ff.Name) Then
If Not msgShown Then
MsgBox "Hey you forgot to fill out these fields, they are 'mandatory' so go back and do that please, thanks!", vbExclamation
msgShown = True
End If
Do
' sInFld = InputBox("Request date required, please fill in below." + vbCr + vbCr + _
"@" + ff.Name + " is the current text fields to fill in !")
sInFld = InputBox("Request date required, please fill in below." + vbCr + vbCr + _
"@" + ffNameDict(ff.Name) + " is the current text fields to fill in !")
Loop While sInFld = ""
ff.Result = sInFld
End If
Next ff
d.Save
End Sub