Word 2007 save as macro

"Please leave a message at the beep, we will get back to you when your support contract expires."

Moderators: phlip, Moderators General, Prelates

User avatar
bentheimmigrant
Dotcor Good Poster
Posts: 1363
Joined: Fri Apr 25, 2008 9:01 pm UTC
Location: UK

Word 2007 save as macro

Postby bentheimmigrant » Wed Oct 27, 2010 5:08 pm UTC

I have written a macro to get Word 2007 to prompt the user for the experiment name, which it then appends to the end of the date, and saves to a predetermined folder. This runs on the startup of a particular docm I have on my desktop. I would like to be able to ask the user to select the folder, but I am unable to, due to my lack of skillz. Also, I would like to be able to set the default folder to a certain folder, as most (but not all) of my files will go there.

My code so far:

Code: Select all

Sub Naming()
'
' Naming Macro
'
'
Dim sTestName As String
Dim sPrompt As String
Dim y As Integer
Dim m As Integer
Dim d As Integer
If ActiveDocument.Name = "Experiment writeup.docm" Then
1: sPrompt = "Please enter the experiment name"
sTestName = InputBox(sPrompt)
If sTestName = "" Then GoTo 1
y = Year(Date)
m = Month(Date)
d = Day(Date)
ThisFile = y & "-" & m & "-" & d & " " & sTestName
Application.DisplayAlerts = False
ActiveDocument.SaveAs FileName:="C:\Documents and Settings\[redacted]\My Documents\A PhD project\Experimental procedures\" & ThisFile, FileFormat:=16
Application.DisplayAlerts = True
End If
End Sub


I had already written a similar macro for excel, and I was able to choose the folder using this, but putting it into word and changing ActiveSheet to ActiveDocument did not seem to work, so I cut off the routines in charge of folder selection and entered a set path. It's mostly stuff I found through google, so I suspect it's a bit uglier than would be ideal. Spoilered to avoid confusion as to which one I'm asking help for (i.e., not the one below).

Spoiler:

Code: Select all

Dim ThisFile As String

Sub Naming()
Dim sTestName As String
Dim sPrompt As String
Dim y As Integer
Dim m As Integer
Dim d As Integer
If ThisWorkbook.Name = "Results Template.xlsm" Then
1: Sheets(1).Select
sPrompt = "Please enter the experiment name"
sTestName = InputBox(sPrompt)
If sTestName = "" Then GoTo 1
y = Year(Date)
m = Month(Date)
d = Day(Date)
ThisFile = y & "-" & m & "-" & d & " " & sTestName
Application.DisplayAlerts = False
CommandButton1_Click
Application.DisplayAlerts = True
End If
End Sub

Private Sub CommandButton1_Click()
     
    Dim UserDirectory As String
     
2:    UserDirectory = Get_Folder("Choose the folder this spreadsheet will be saved in")
    If UserDirectory = "" Then Exit Sub
    UserDirectory = UserDirectory & "/"
     On Error GoTo ErrorHandler
     ActiveWorkbook.SaveAs Filename:=UserDirectory & ThisFile, FileFormat:=51
     Exit Sub
ErrorHandler:
     MsgBox "Make sure the desired folder is highlighted!!!", 53
     GoTo 2
End Sub
 
Private Function Get_Folder(Optional HeaderMsg As String) As String
     
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath
        .Title = HeaderMsg
        If .Show = -1 Then
            Get_Folder = .SelectedItems(1)
        Else
            Get_Folder = ""
        End If
    End With
     
End Function
"Comment is free, but facts are sacred" - C.P. Scott

Return to “The Help Desk”

Who is online

Users browsing this forum: No registered users and 5 guests