Cacher is the code snippet organizer for pro developers

Dim currDocName() As String
Dim AcurrDocName
Dim getName, currDesk, openName, finName, currFile As String
Dim openDoc
Dim aa

selection.WholeStory
selection.Copy
currFile = ActiveDocument.Path + "\"
currDocName = Split(ActiveDocument.name, "-")
AcurrDocName = Split(ActiveDocument.name, ".")
getName = currDocName(0)
currDesk = CreateObject("WScript.Shell").SpecialFolders("Desktop")
If InStr(AcurrDocName(0), "ori") > 0 Then
  finName = currDocName(0) & "-" & currDocName(1) & "-" & "done"
  Else
  finName = AcurrDocName(0) & "-" & "done"
End If

openName = currDesk + "\Word templates\" + getName + "-template.dot"
Documents.Add Template:=openName, NewTemplate:=False, DocumentType:=0
ActiveDocument.Content.Select
selection.Paste
  ChangeFileOpenDirectory currFile
  ActiveDocument.SaveAs2 FileName:=finName, FileFormat _
    :=wdFormatXMLDocument, LockComments:=False, Password:="", _
    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
    :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
selection.WholeStory