Auto click save when "Save As" box pops up

[sgelnap]

I have over 5000 documents to rename with the text in the first line of each document.
I can currently open-->copy & paste to a new document-->save new document as (with the desired file name)-->BUT I have to click save for each until it cycles through all 5000 documents.

How can I avoid manually clicking save? Here's the code

Option Explicit
 
Dim scrFso As Object 'a FileSystemObject
Dim scrFolder As Object 'the folder object
Dim scrSubFolders As Object 'the subfolders collection
Dim scrFile As Object 'the file objectr
Dim scrFiles As Object 'the files objectr
 
Sub OpenAllFilesInFolder()
 
'starting place for trav macro
'strStartPath is a path to start the traversal on
 
Dim strStartPath As String
strStartPath = "C:\Users\ACF1\Downloads\Movies\menu\salad"
 
'stop the screen flickering
Application.ScreenUpdating = False
 
'open the files in the start folder
OpenAllFiles strStartPath
'search the subfolders for more files
SearchSubFolders strStartPath
 
'turn updating back on
Application.ScreenUpdating = True
 
End Sub
 
 
Sub SearchSubFolders(strStartPath As String)
 
'starts at path strStartPath and traverses its subfolders and files
'if there are files below it calls OpenAllFiles, which opens them one by one
'once its checked for files, it calls itself to check for subfolders.
 
If scrFso Is Nothing Then Set scrFso = CreateObject("scripting.filesystemobject")
Set scrFolder = scrFso.getfolder(strStartPath)
Set scrSubFolders = scrFolder.subfolders
For Each scrFolder In scrSubFolders
Set scrFiles = scrFolder.Files
If scrFiles.Count > 0 Then OpenAllFiles scrFolder.Path 'if there are files below, call openFiles to open them
SearchSubFolders scrFolder.Path 'call ourselves to see if there are subfolders below
Next
 
End Sub
 
Sub OpenAllFiles(strPath As String)
 
' runs through a folder oPath, opening each file in that folder,
' calling a macro called samp, and then closing each file in that folder
 
Dim strName As String
Dim wdDoc As Document
 
If scrFso Is Nothing Then Set scrFso = CreateObject("scripting.filesystemobject")
Set scrFolder = scrFso.getfolder(strPath)
For Each scrFile In scrFolder.Files
strName = scrFile.Name 'the name of this file
Application.StatusBar = strPath & "\" & strName 'the status bar is just to let us know where we are
'we'll open the file fName if it is a word document or template
If Right(strName, 4) = ".doc" Or Right(strName, 4) = ".dot" Then
Set wdDoc = Documents.Open(FileName:=strPath & "\" & strName, _
ReadOnly:=False, Format:=wdOpenFormatAuto)
 
'Call the macro that performs work on the file pasing a reference to it
DoWork wdDoc
 
'we close saving changes
wdDoc.Close wdSaveChanges
End If
Next
 
'return control of status bar to Word
Application.StatusBar = False
End Sub
 
'this is where a macro would be that would actually do something
Sub DoWork(wdDoc As Document)
Selection.WholeStory
Selection.Copy
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
Selection.PasteAndFormat (wdPasteDefault)
ChangeFileOpenDirectory _
"C:\Users\ACF1\Downloads\Movies\menu\dalas"
Documents.Save NoPrompt:=True, _
OriginalFormat:=wdOriginalDocumentFormat
ActiveWindow.Close
End Sub

Thanks in advance for the assistance.

 

[AlphaFrog]

Try using the .SaveAs method instead of .Save

    Documents.SaveAs Filename:="[COLOR="Red"]???[/COLOR]", _
                     FileFormat:=wdFormatDocument

You'll have to give it a file name.


Forum Tip: Pasting VBA code
It would be best if you surround your VBA code with code tags e.g [CODE]your VBA code here[/CODE]
It makes reading your VBA code much easier. When you're in the forum editor, highlight your pasted VBA code and then click on the icon with the pound or number sign #.

 

[sgelnap]

Thanks a bunch,

The filename is automatically generated by the the text in the first line of the document. The name shows in the save as box already, now I need to have the code finish the save process automatically and move on to the next file.

The code you suggest causes all the files to have the same name.

thanks again