Save .docx file as .dotx file

[Dave]

Trying to VBA some code to change a regular Word .docx file to a Word .dotx template file. For testing I've created a maketemplate.docx file with a bookmark in my documents folder. Manually I can open the file and then save as a Word Template in the Custom Office Templates folder. The new maketemplate.dotx file is created maintaining the bookmark and operating as any Word template. However, I can't seem to VBA replicate this or Google a solution. I've tried just using copyfile and thne using copyfile the original .docx to the Custom Office Templates folder and then opening the file and saving as a .dotx ... didn't work. Tried just opening the file and saving to the Custom Office Templates folder but that also didn't work. For each failure(s) the maketemplate.dotx is created but when opened, only contains the Word application. So, how to VBA an existing .docx file to a .dotx file? Dave
Here's some code that fails....

Sub test()
'Dim OfsObj As Object
'Set OfsObj = CreateObject("Scripting.FilesystemObject")
'source Records     \ destination
'OfsObj.CopyFile ThisWorkbook.Path & "\maketemplate.docx", _
    ThisWorkbook.Path & "\Custom Office Templates\maketemplate.dotx", True


'OfsObj.CopyFile ThisWorkbook.Path & "\maketemplate.docx", _
    ThisWorkbook.Path & "\Custom Office Templates\maketemplate.docx", True
'Set OfsObj = Nothing


Dim wd As Object, ObjDoc As Object
On Error Resume Next
Set wd = GetObject(, "word.application")
If Err.Number <> 0 Then
On Error GoTo 0
Set wd = CreateObject("Word.Application")
End If
wd.Visible = False
'Set ObjDoc = wd.Documents.Open(ThisWorkbook.Path & "\Custom Office Templates\maketemplate.docx")
Set ObjDoc = wd.Documents.Open(ThisWorkbook.Path & "\maketemplate.docx")
ObjDoc.SaveAs2 (ThisWorkbook.Path & "\Custom Office Templates\maketemplate.dotx")
ObjDoc.Close
Set ObjDoc = Nothing
wd.Quit
Set wd = Nothing
End Sub

[gmayor]

The following should work provided the document and the two folders exist

Sub test()
Dim wd As Object, ObjDoc As Object
Dim bOpen As Boolean
    On Error Resume Next
    Set wd = GetObject(, "word.application")
    If Err.Number <> 0 Then
        On Error GoTo 0
        Set wd = CreateObject("Word.Application")
        bOpen = True
    End If
    wd.Visible = False
    Set ObjDoc = wd.Documents.Open(ThisWorkbook.Path & "\maketemplate.docx")
    ObjDoc.SaveAs2 Filename:=ThisWorkbook.Path & "\Custom Office Templates\maketemplate.dotx", FileFormat:=14
    ObjDoc.Close
    Set ObjDoc = Nothing
    If bOpen = True Then wd.Quit
    Set wd = Nothing
End Sub

[Dave]

That works. Thank you very much Graham. Have a nice day. Dave