Microsoft Marco to "Save As" in a specified folder on desktop.

[TyphoonDIGITS]

Can this be done? I want it to perform these steps in this order.
1. Highlight all and change font to 8.
2. Save to one of several folers on desktop.
2.. I will be making a bunch of these macros to use with each having their own specified folder.

Need help with the starting code for this.

 

[TyphoonDIGITS]

Here's what I've got so far.

Sub Macro1()
'
' Macro1 Macro
'
'
Selection.WholeStory
Selection.Font.Size = 8
ChangeFileOpenDirectory "C:\Users\my.name\Desktop\SPECIFIEDFOLDER\"
ActiveDocument.SaveAS FileName:="nameofdoc.docx", FileFormat:= _
wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True, _
WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, Encoding:=1252, InsertLineBreaks:=False, AllowSubstitutions:=False _
, LineEnding:=wdCRLF
End Sub

 

[TyphoonDIGITS]

How about this one. I think I can just make one macro for each folder but I want the program to ask me what to name each file before saving. Any ideas? I think i have to add something to replace the ActiveDocument.SaveAS FileName:="xxx" xxx part. Help!


Sub CustomerService()
'
' CustomerService Macro
'
'
Selection.WholeStory
Selection.Font.Size = 8

ChangeFileOpenDirectory _
"C:\Users\MY.NAME\Desktop\SPECIFIEDFOLDER\"
ActiveDocument.SaveAS FileName:="xxx", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False

End Sub

 

[fumei]

1. "1. Highlight all and change font to 8. "
Why? It has zero relevance to file Saveas. You want the whole document to be font size 8?

ActiveDocument.Range.Font.Size = 8

Done. No need to select (highlight) anything.


2. why are you manually formatting?

3. why are you changing the OPEN folder? If you know what the folders are:

Sub SaveToABunch()
Dim j As Long
Dim DesktopFolders()
DeskTopFolders = Split( _
     "C:\Users\MY.NAME\Desktop\FOLDER_A\|" & _
     "C:\Users\MY.NAME\Desktop\FOLDER_B\|" & _
     "C:\Users\MY.NAME\Desktop\FOLDER_C\|" & _
     "C:\Users\MY.NAME\Desktop\FOLDER_D\|", "|")

For j = 0 To 3
    ActiveDocument.SaveAs Filename:= DeskTopFolders(j) & _
        InputBox("Name please.")
Next
End Sub

Each iteration - in this case four - will ask for a filename and write the file as a separate SaveAs to:

Folder_A, and then
Folder_B, and then
Folder_C, and then
Folder_D

NOTE! As it stands, you need to type the ".doc" to each. If you want to not do this, change:

    ActiveDocument.SaveAs Filename:= DeskTopFolders(j) & _
        InputBox("Name please.")

to:

    ActiveDocument.SaveAs Filename:= DeskTopFolders(j) & _
        InputBox("Name please.") & ".doc"

So if they type in "yaddaWhatever" it will get saved as yaddaWhatever.doc

Lastly, if you change the FileOPENDirectory (and as far I am concerned you rarely, if ever, actually need to do this), it is best practice to change it back to whatever it was.

Gerry

 

[TyphoonDIGITS]

Can you copy and paste this code with your alterations so it asks me what to name my file? This does what I want except the naming thing. Thanks for your response!

Sub CustomerService()
'
' CustomerService Macro
'
'
Selection.WholeStory
Selection.Font.Size = 8

ChangeFileOpenDirectory _
"C:\Users\MY.NAME\Desktop\SPECIFIEDFOLDER\"
ActiveDocument.SaveAS FileName:="xxx", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False

End Sub

 

[SkipVought]

Check the InputBox function.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[fumei]

Can you copy and paste this code with your alterations so it asks me what to name my file? This does what I want except the naming thing. Thanks for your response! "

Please read my post...I already did that.


Gerry

 

[jontout]

I have something similar which might be of use.

exportPath = "H:\Avaya\AvayaReports\"
exportName = sheetName & ".xls"

RepName = exportPath & exportName

    Sheets("Report").Select
    Sheets("Report").Copy
    Sheets("Report").Name = sheetName
    
    ActiveWorkbook.SaveAs Filename:=RepName, FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWindow.Close

which takes the activesheet and copies it to a new workbook, saves it to the network somewhere and closes the copy.

 

[jontout]

Missing from the first line of above code.

sheetName = Replace(UserForm1.txtDate.Value, "/", ".") & "_CsReport"

Where I'm using the report date to name the sheet, I suppose you could use the folder names or create an array of 'directory folders' to loop through the process?

 

[fumei]

1. this is for Word
2. a userform is not involved
3. multiple folders and multiple filenames are involved

Gerry