Const NameFileDot = "DOC.dot"

Sub CreateDots()
    PathDot = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, NameFileDot)
    NewFolder = NewFolderName & Application.PathSeparator
    Filename = NewFolder & "DOC1"

Set WD = WA.Documents.Add(PathDot): DoEvents
     
     WD.SaveAs Filename & ".pdf", wdFormatPDF
     
     WD.Close False
     DoEvents

End Sub