Originally Posted by Guessed

That requires a bit more effort. This takes the current filename before the first period (assuming the first period is at the file extension), and appends the new file extension
Sub Savetolocation()


Dim sLocation As String, sFile as String
sFile = Split(ActiveDocument.Name,".")(0) & ".docx"
sLocation = "C:\Users\dwirony\My Documents\Overflow Folder\" & sFile
ActiveDocument.SaveAs2 FileName:=sLocation, FileFormat:=wdFormatXMLDocument, CompatibilityMode:=14
End Sub