How to save all open document into some the folder?

[avkokin]

Hello.
There is many open documents. Some has names, some - is a new (not
saved). I need to save they all into one some folder. How?
Your help is much appreciated.

 

[fumei via OfficeKB.com]

Dim aDoc As Document
Dim NewName As String
Dim ToFolder As String

' change to the folder path you want
' make SURE you have the \ at the end!
ToFolder = "c:\zzz\"

For Each aDoc In Documents
' if document is NOT saved
If aDoc.Saved = False Then
' get a name
NewName = InputBox("Enter name for unsaved file.")
' save it with folder and name
aDoc.SaveAs FileName:=ToFolder & NewName
Else
' save with current name
' but in given folder
aDoc.SaveAs FileName:=ToFolder & aDoc.Name
End If
Next