Sub SaveCopyAs(doc As Document, NeuerPfad As String)
    Dim fs As Object
    Dim f As Object
 
    doc.Save   'damit auch neue (nicht gespeicherte) Änderungen in der Kopie 
    ' sind
 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(doc.FullName)
 
    f.Copy NeuerPfad, True
End Sub