B
Bruce McCormick
I have written a macro that collects information from a user, then updates
all the templates within a give folder. The problem is that the macro is
crashing when it tries to save the template. This doesn't happen with every
template. Sometimes it gets through three or four before crashing. I have
pulled my hair out trying to figure out what the problem is. Any
suggestions? (I have indicated the line that is causing the crash below.)
Also, how do you release the frmUserInformationForm variable form?
frmUserInformationForm = Nothing doesn't work.
'===========================================================================
========
' Procedure : UpdateUserInfo
' Author : Bruce McCormick
' Date : 1/6/2004 06:02
' Purpose : Allows the user to update their document templates in one
pass.
' Shortcut : None
' Modified : 1/6/2004 06:02
'===========================================================================
========
Public Sub UpdateUserInfo()
' Declare the variables:
Dim MyUserForm As frmUserInformationForm
Dim sUserName As String
Dim sUserJobTitle As String
Dim sUserDirectPhone As String
Dim sUserFaxPhone As String
Dim sUserEmailAddress As String
Dim sUserDivision As String
Dim sTemplatesPath As String
Dim x As Integer
Dim wdDot As Object
'Collect the user's information via a custom form:
Set MyUserForm = New frmUserInformationForm
MyUserForm.Tag = "Cancel"
'Populate the fields with the current information"
On Error Resume Next
MyUserForm.txtUserName = Application.UserName
MyUserForm.txtUserJobTitle = _
ActiveDocument.CustomDocumentProperties("UserJobTitle")
MyUserForm.txtUserDirectPhone = _
ActiveDocument.CustomDocumentProperties("UserDirectPhone")
MyUserForm.txtUserFaxPhone = _
ActiveDocument.CustomDocumentProperties("UserFaxPhone")
MyUserForm.txtUserEmailAddress = _
ActiveDocument.CustomDocumentProperties("UserEmailAddress")
MyUserForm.cboDivision = _
ActiveDocument.CustomDocumentProperties("UserDivision")
'Show the form:
MyUserForm.Show vbModal
'Save the user information to variables:
If MyUserForm.Tag = "OK" Then 'User pressed OK
sUserName = MyUserForm.txtUserName
sUserJobTitle = MyUserForm.txtUserJobTitle
sUserDirectPhone = MyUserForm.txtUserDirectPhone
sUserFaxPhone = MyUserForm.txtUserFaxPhone
sUserEmailAddress = MyUserForm.txtUserEmailAddress
sUserDivision = MyUserForm.cboDivision.Value
Else
GoTo Shutdown 'User pressed Cancel
End If
'Display a message to the user to be patient:
Application.ScreenRefresh
Dim MyAlertForm As frmBePatient
Set MyAlertForm = New frmBePatient
MyAlertForm.Show vbModeless
MyAlertForm.Repaint
'Insert the variables into each template and update
sTemplatesPath = Options.DefaultFilePath(wdUserTemplatesPath) + "\" + _
sUserDivision + "\"
'Set the user's name in the Tools | Options | User Information dialog
Application.UserName = sUserName
' Save the variables to the DDC template:
SetCustomProperty "UserJobTitle", sUserJobTitle
SetCustomProperty "UserDirectPhone", sUserDirectPhone
SetCustomProperty "UserFaxPhone", sUserFaxPhone
SetCustomProperty "UserEmailAddress", sUserEmailAddress
SetCustomProperty "UserDivision", sUserDivision
ActiveDocument.Close SaveChanges:=wdSaveChanges
'Set the other variables as custom document properties:
'Display a message to the user to be patient:
With Application.FileSearch
.NewSearch
.FileName = "*.dot"
.LookIn = sTemplatesPath
.Execute
For x = 1 To .FoundFiles.Count
Set wdDot = Documents.Open(.FoundFiles(x))
'Add User Job Title:
SetCustomProperty "UserJobTitle", sUserJobTitle
'Add User Direct Phone Number:
SetCustomProperty "UserDirectPhone", sUserDirectPhone
'Add User Fax Phone Number:
SetCustomProperty "UserFaxPhone", sUserFaxPhone
'Add User E-mail Address:
SetCustomProperty "UserEmailAddress", sUserEmailAddress
'Add User Division:
SetCustomProperty "UserDivision", sUserDivision
'Update the document with the new values:
Selection.WholeStory
Selection.Fields.Update
Selection.HomeKey Unit:=wdStory
'Save the document:
' *** This is the line that is causing the crash! ***
Documents(wdDot).Close SaveChanges:=wdSaveChanges
Next
End With
Shutdown:
' Release the variables:
'MyUserForm = Nothing
sUserName = vbNull
sUserJobTitle = vbNull
sUserDirectPhone = vbNull
sUserFaxPhone = vbNull
sUserEmailAddress = vbNull
sUserDivision = vbNull
sTemplatesPath = vbNull
x = vbNull
wdDot = Nothing
End Sub
'===========================================================================
========
' Procedure : SetCustomProperty
' Author : Bruce McCormick
' Date : 1/6/2004 06:38
' Purpose : Checks to see if the CustomDocumentProperty exists in the
Active
' : Document. If yes, and the value is unchanged, it exists the
routine
' : without doing anything. If the value has changed, it updates
the
' : the property to the new value. If the property didn't
previously
' : exits, it creates a property with the new value.
' Shortcut : None
' Modified : 1/6/2004 06:38
'===========================================================================
========
Private Sub SetCustomProperty(sPropertyName As String, sPropertyValue As
String)
' Declare the variables:
Dim oProperty As DocumentProperty
Dim bPropertyExists As Boolean
' See if the CustomDocument Property Exists:
For Each oProperty In ActiveDocument.CustomDocumentProperties
If oProperty.Name = sPropertyName Then
' If yes, set a flag and exit the loop:
' Check to see if the value changed:
If oProperty.Value <> sPropertyValue Then
' If true, delete the value and set the flag to false:
oProperty.Delete
bPropertyExists = False
Else
' Otherwise, set the flag to true
bPropertyExists = True
End If
Exit For
End If
' If no, loop back through:
Next oProperty
' If the CustomDocument Property Does not Exist, add it:
If bPropertyExists = False Then
ActiveDocument.CustomDocumentProperties.Add _
Name:=sPropertyName, _
Type:=msoPropertyTypeString, _
Value:=sPropertyValue, _
LinkToContent:=False
End If
' Release the variables:
bPropertyExists = False
End Sub
all the templates within a give folder. The problem is that the macro is
crashing when it tries to save the template. This doesn't happen with every
template. Sometimes it gets through three or four before crashing. I have
pulled my hair out trying to figure out what the problem is. Any
suggestions? (I have indicated the line that is causing the crash below.)
Also, how do you release the frmUserInformationForm variable form?
frmUserInformationForm = Nothing doesn't work.
'===========================================================================
========
' Procedure : UpdateUserInfo
' Author : Bruce McCormick
' Date : 1/6/2004 06:02
' Purpose : Allows the user to update their document templates in one
pass.
' Shortcut : None
' Modified : 1/6/2004 06:02
'===========================================================================
========
Public Sub UpdateUserInfo()
' Declare the variables:
Dim MyUserForm As frmUserInformationForm
Dim sUserName As String
Dim sUserJobTitle As String
Dim sUserDirectPhone As String
Dim sUserFaxPhone As String
Dim sUserEmailAddress As String
Dim sUserDivision As String
Dim sTemplatesPath As String
Dim x As Integer
Dim wdDot As Object
'Collect the user's information via a custom form:
Set MyUserForm = New frmUserInformationForm
MyUserForm.Tag = "Cancel"
'Populate the fields with the current information"
On Error Resume Next
MyUserForm.txtUserName = Application.UserName
MyUserForm.txtUserJobTitle = _
ActiveDocument.CustomDocumentProperties("UserJobTitle")
MyUserForm.txtUserDirectPhone = _
ActiveDocument.CustomDocumentProperties("UserDirectPhone")
MyUserForm.txtUserFaxPhone = _
ActiveDocument.CustomDocumentProperties("UserFaxPhone")
MyUserForm.txtUserEmailAddress = _
ActiveDocument.CustomDocumentProperties("UserEmailAddress")
MyUserForm.cboDivision = _
ActiveDocument.CustomDocumentProperties("UserDivision")
'Show the form:
MyUserForm.Show vbModal
'Save the user information to variables:
If MyUserForm.Tag = "OK" Then 'User pressed OK
sUserName = MyUserForm.txtUserName
sUserJobTitle = MyUserForm.txtUserJobTitle
sUserDirectPhone = MyUserForm.txtUserDirectPhone
sUserFaxPhone = MyUserForm.txtUserFaxPhone
sUserEmailAddress = MyUserForm.txtUserEmailAddress
sUserDivision = MyUserForm.cboDivision.Value
Else
GoTo Shutdown 'User pressed Cancel
End If
'Display a message to the user to be patient:
Application.ScreenRefresh
Dim MyAlertForm As frmBePatient
Set MyAlertForm = New frmBePatient
MyAlertForm.Show vbModeless
MyAlertForm.Repaint
'Insert the variables into each template and update
sTemplatesPath = Options.DefaultFilePath(wdUserTemplatesPath) + "\" + _
sUserDivision + "\"
'Set the user's name in the Tools | Options | User Information dialog
Application.UserName = sUserName
' Save the variables to the DDC template:
SetCustomProperty "UserJobTitle", sUserJobTitle
SetCustomProperty "UserDirectPhone", sUserDirectPhone
SetCustomProperty "UserFaxPhone", sUserFaxPhone
SetCustomProperty "UserEmailAddress", sUserEmailAddress
SetCustomProperty "UserDivision", sUserDivision
ActiveDocument.Close SaveChanges:=wdSaveChanges
'Set the other variables as custom document properties:
'Display a message to the user to be patient:
With Application.FileSearch
.NewSearch
.FileName = "*.dot"
.LookIn = sTemplatesPath
.Execute
For x = 1 To .FoundFiles.Count
Set wdDot = Documents.Open(.FoundFiles(x))
'Add User Job Title:
SetCustomProperty "UserJobTitle", sUserJobTitle
'Add User Direct Phone Number:
SetCustomProperty "UserDirectPhone", sUserDirectPhone
'Add User Fax Phone Number:
SetCustomProperty "UserFaxPhone", sUserFaxPhone
'Add User E-mail Address:
SetCustomProperty "UserEmailAddress", sUserEmailAddress
'Add User Division:
SetCustomProperty "UserDivision", sUserDivision
'Update the document with the new values:
Selection.WholeStory
Selection.Fields.Update
Selection.HomeKey Unit:=wdStory
'Save the document:
' *** This is the line that is causing the crash! ***
Documents(wdDot).Close SaveChanges:=wdSaveChanges
Next
End With
Shutdown:
' Release the variables:
'MyUserForm = Nothing
sUserName = vbNull
sUserJobTitle = vbNull
sUserDirectPhone = vbNull
sUserFaxPhone = vbNull
sUserEmailAddress = vbNull
sUserDivision = vbNull
sTemplatesPath = vbNull
x = vbNull
wdDot = Nothing
End Sub
'===========================================================================
========
' Procedure : SetCustomProperty
' Author : Bruce McCormick
' Date : 1/6/2004 06:38
' Purpose : Checks to see if the CustomDocumentProperty exists in the
Active
' : Document. If yes, and the value is unchanged, it exists the
routine
' : without doing anything. If the value has changed, it updates
the
' : the property to the new value. If the property didn't
previously
' : exits, it creates a property with the new value.
' Shortcut : None
' Modified : 1/6/2004 06:38
'===========================================================================
========
Private Sub SetCustomProperty(sPropertyName As String, sPropertyValue As
String)
' Declare the variables:
Dim oProperty As DocumentProperty
Dim bPropertyExists As Boolean
' See if the CustomDocument Property Exists:
For Each oProperty In ActiveDocument.CustomDocumentProperties
If oProperty.Name = sPropertyName Then
' If yes, set a flag and exit the loop:
' Check to see if the value changed:
If oProperty.Value <> sPropertyValue Then
' If true, delete the value and set the flag to false:
oProperty.Delete
bPropertyExists = False
Else
' Otherwise, set the flag to true
bPropertyExists = True
End If
Exit For
End If
' If no, loop back through:
Next oProperty
' If the CustomDocument Property Does not Exist, add it:
If bPropertyExists = False Then
ActiveDocument.CustomDocumentProperties.Add _
Name:=sPropertyName, _
Type:=msoPropertyTypeString, _
Value:=sPropertyValue, _
LinkToContent:=False
End If
' Release the variables:
bPropertyExists = False
End Sub