Word Macro to print all active docs to PC Folder

[cjmitton]

We have a document production system that gives crazy filenames / directory structure thats a nightmare to navigate around. Usually this is not an issue as we view them through the system and alls well!

Since we've had a little change to the way our business works we need to send 6 or so documents to clients via a 'portal'.

Due to the way the documents are named, its imposible to navigate to where the files are stored on the server, then select the files we need to 'upload' to the portal. What the current solution is that the users uses the system to open the relevent files (usually between 6 to 8 docs) then save each one, one by one to the 'My Documents' folder. Do the upload then delete them so we're not keeping anything on the PC.

I want to create a macro in Word 2010 to do a 'save as' on all active word documents. I've had and try a failed with my own usual style as I have no idea on how to 'find' the active word documents running?

Any help would be great.

 

[Macropod]

Hi cjmitton,

Try something along the lines of:

Sub Demo()
Dim wdDoc As Document
For Each wdDoc In Documents
  With wdDoc
    .SaveAs FileName:=Options.DefaultFilePath(wdDocumentsPath) & "\" & .Name, _
      AddToRecentFiles:=False
    .Close
  End With
Next
End Sub

The above code saves all open documents to the user's default save location, then closes the file - you may want to change either behaviour.

 

[cjmitton]

Thanks for the reply! its so close...

The Macro works but stops halfway through? My guess is that the instance of word that is running the macro is closed?

Any ideas, I've tried running from a blank document and it still happens?

 

[Macropod]

Hi cjmitton,

It would probably be best for the macro to be added to either your Normal template. If you add it to another document (preferably not one of the ones you're working on), the macro needs to be coded along the lines of:

Sub Demo()
Dim wdDoc As Document
For Each wdDoc In Documents
  With wdDoc
    If .Name <> ActiveDocument.Name Then
      .SaveAs FileName:=Options.DefaultFilePath(wdDocumentsPath) & "\" & .Name, _
        AddToRecentFiles:=False
      .Close
    End If
  End With
Next
End Sub