VBA Snippets

AttachCorrectTemplate

source code

Exists

Public Function Template_NormalExists(Optional ByVal bInformUser As Boolean = True) As Boolean
Dim objtemplate As Word.Template
Dim itemplatecount As Integer
   On Error GoTo AnError
   If gbEND = True Then Exit Function
   For itemplatecount = 1 To Application.Templates.Count
      If Len(Application.Templates(itemplatecount).Name) >= 6 Then
         If Left(Application.Templates(itemplatecount).Name, 6) = "Normal" Then
            Set objtemplate = Application.Templates(itemplatecount)
            Template_NormalExists = True
            Exit For
         Else
            Template_NormalExists = False
         End If
      Else
         Template_NormalExists = False
      End If
   Next itemplatecount
   If Template_NormalExists = False Then
      If bInformUser = True Then
         Call NormalTemplateDoesNotExistInformation
      End If
   End If
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("Template_NormalExists", msMODULENAME, _
        "determine if the Normal template exists.")
End Function

Exists

source code

Remove

source code

Remove

Public Sub Doc_TemplateRemove(ByVal sFolderPath As String, _
                              ByVal sFileName As String, _
                     Optional ByVal bSameFolderPath As Boolean = False, _
                     Optional ByVal sExtension As String = ".dot")
   On Error GoTo AnError
   If bSameFolderPath = True Then
      sFolderPath = ActiveDocument.AttachedTemplate.Path & "\"
   End If
   ActiveDocument.AttachedTemplate = sFolderPath & sFileName & sExtension

   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle("Doc_TemplateRemove", msMODULENAME, 1, _
       "remove the attached template from the active document")
End Sub
'****************************************************************************************

ReturnPath

Public Function Template_ReturnPath() As String



   On Error GoTo AnError



   Template_ReturnPath = Templates(1).FullName

'think about checking the "/" or Application.PathSeparator character ???



   If gbDEBUG = False Then Exit Function

AnError:

   Call Error_Handle(msMODULENAME, "Template_ReturnPath", 1, _

        "")

End Function

'****************************************************************************************

SavedGet

Public Function Template_NormalSavedGet() As Boolean
Dim objtemplate As Word.Template
Dim itemplatecount As Integer
   On Error GoTo AnError
   If gbEND = True Then Exit Function
   For itemplatecount = 1 To Application.Templates.Count
      If Len(Application.Templates(itemplatecount).Name) >= 6 Then
         If Left(Application.Templates(itemplatecount).Name, 6) = "Normal" Then
            Set objtemplate = Application.Templates(itemplatecount)
            Template_NormalSavedGet = objtemplate.Saved
            Exit Function
         End If
      End If
   Next itemplatecount
   Template_NormalSavedGet = False
   Call NormalTemplateDoesNotExistInformation
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("Template_NormalSavedGet", msMODULENAME, _
        "determine if the Normal template needs to be saved.")
End Function

SavedSet

Public Sub Template_NormalSavedSet(ByVal bTrueOrFalse As Boolean)
Dim objtemplate As Word.Template
Dim itemplatecount As Integer
   On Error GoTo AnError
   If gbEND = True Then Exit Sub
   For itemplatecount = 1 To Application.Templates.Count
      If Len(Application.Templates(itemplatecount).Name) >= 6 Then
         If Left(Application.Templates(itemplatecount).Name, 6) = "Normal" Then
            Set objtemplate = Application.Templates(itemplatecount)
            objtemplate.Saved = bTrueOrFalse
            Exit Sub
         End If
      End If
   Next itemplatecount
   Call NormalTemplateDoesNotExistInformation
   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   Call Error_Handle("Template_NormalSavedSet", msMODULENAME, _
        "save the Normal template.")
End Sub