Hoping for help on the following:
I'm trying to write a macro that saves documents like this:
1- P: will always be the drive letter
2- user input will determine the folder
3- first 8 characters of filename will be current date in yyyymmdd
format
4- next 3 characters will be the author
4- next will be a dash, then user input's description.
All I know how to do is the following (defining and capturing a few of
the variables):
Dim folder As String
Dim author As Long
Dim description As String
folder = InputBox("Folder to Save in:")
author = InputBox("1-CL 2-RH 3-KH")
description = InputBox("Description")
Try the following code. I sent in unwrapped, but your reader may wrap it.
You will need to modify some constants. Some error checking is left as
an exercise for the reader.
--
Michael Bednarek
http://mbednarek.com/ "POST NO BILLS"
===== cut here =====
Option Explicit
Sub SaveKaren()
' Response by Michael Bednarek to a problem from karenhart in microsoft.public.word.vba.general (24-Jan-2010)
' Message-ID: <880e108f-87af-48e9-bcb5-46dd7428badd@e16g2000pri.googlegroups.com>
' Subject: Saving a document based on user input
Dim strFolder As String
Dim datToday As Date
Dim strYYYYMMDD As String
Dim strAuthor As String
Dim strDescr As String
Const strDRIVE As String = "D:\"
Const strINIDIR As String = "Temp\"
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Save in which folder?"
.InitialView = msoFileDialogViewDetails
.InitialFileName = strDRIVE & strINIDIR
If .Show = -1 Then
strFolder = .SelectedItems(1) & "\"
Debug.Print strFolder
Else
MsgBox "No folder selected. Nothing done.", vbOKOnly + vbExclamation, "SaveKaren"
Exit Sub
End If
End With
datToday = Date
strYYYYMMDD = Format(datToday, "yyyy") & Format(datToday, "mm") & Format(datToday, "dd")
Debug.Print strYYYYMMDD
strAuthor = InputBox("Enter author (up to 3 characters):", "SaveKaren", "KH")
strAuthor = Pad(Left(strAuthor, 3), 3, "_")
strDescr = InputBox("Enter description:", "SaveKaren", "Description of this document")
strDescr = CleanFilename(strDescr)
ActiveDocument.SaveAs FileName:=strFolder & strYYYYMMDD & strAuthor & strDescr
End Sub
Function Pad(strString As String, lngLength As Long, Optional strPad As String = " ")
Pad = strString & String(lngLength - Len(strString), strPad)
End Function
Function CleanFilename(strParam As String)
' Rids the argument of characters illegal in a filename.
Const strIllegal As String = "\/:*?""<>|" ' The illegal characters in a filename
Static l As Long ' The length of the above string
Dim i As Long ' Loop counter through the string of illegals
Dim oneIllegal As String * 1 ' A single illegal character
If strParam = "" Then ' Anything passed?
CleanFilename = "" ' No: return empty; let the caller deal with it.
Else
If l = Empty Then ' Initialise
l = Len(strIllegal) ' How many illegal characters?
End If
CleanFilename = strParam ' Copy argument to return value
For i = 1 To l ' Loop through the illegal set
oneIllegal = Mid(strIllegal, i, 1) ' Next single illegal character
CleanFilename = Replace(CleanFilename, oneIllegal, "") ' Remove this character
Next i
CleanFilename = Trim(CleanFilename) ' and remove leading and trailing spaces
End If
End Function
