Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Workbook_BeforeSave
I'm having trouble getting this code to work. The dialog box come up and
you can navigate to the directory you want, but the file still saves to the original file name in the original directory. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) a = MsgBox("Are sure you want to save this workbook?", vbYesNo) If a = vbNo Then Cancel = True Else SaveAsUI = True fileSaveName = Application.GetSaveAsFilename("TCR" & Cells(20, 29) & ".xls", fileFilter:="Excel Files (*.xls),*.xls") End If End sub What I want to do is force the user to save the file as TCR plus whatever is in cell AC20, ie TCRSomeone.xls, but I'd like them to be able to save it in the directory they choose. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Workbook_BeforeSave
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean) Static blnSaving As Boolean Dim strFileName As String If blnSaving Then blnSaving = False Else Cancel = True If MsgBox("Are sure you want to save this workbook?", vbYesNo) = vbYes Then strFileName = Application.GetSaveAsFilename("TCR" & Cells(20, 29) & ".xls", _ fileFilter:="Excel Files (*.xls),*.xls") If strFileName < "False" Then blnSaving = True ThisWorkbook.SaveAs strFileName End If End If End If End Sub "Bill Oertell" wrote in message ... I'm having trouble getting this code to work. The dialog box come up and you can navigate to the directory you want, but the file still saves to the original file name in the original directory. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) a = MsgBox("Are sure you want to save this workbook?", vbYesNo) If a = vbNo Then Cancel = True Else SaveAsUI = True fileSaveName = Application.GetSaveAsFilename("TCR" & Cells(20, 29) & ".xls", fileFilter:="Excel Files (*.xls),*.xls") End If End sub What I want to do is force the user to save the file as TCR plus whatever is in cell AC20, ie TCRSomeone.xls, but I'd like them to be able to save it in the directory they choose. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Workbook_BeforeSave
Bill,
Building on the code that Rob provided, see if this does it for you... '============================================= Private blnWantToSave As Boolean Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) If blnWantToSave Then blnWantToSave = False Else Dim FileSaveName As String Dim lngPlace As Long If MsgBox("Are sure you want to save this workbook? ", _ vbYesNo + vbQuestion, "Question from Bill") = vbNo Then blnWantToSave = False Cancel = True Exit Sub Else Cancel = True FileSaveName = _ Application.GetSaveAsFilename("TCR" & Cells(20, 29).Value & _ ".xls",fileFilter:="Excel Files (*.xls),*.xls") End If 'Call function lngPlace = LASTPOSITION(FileSaveName, "\") 'Replace user specified file name with preferred name. FileSaveName = _ Left$(FileSaveName, lngPlace) & "TCR" & Cells(20, 29).Value & ".xls" blnWantToSave = True ActiveWorkbook.SaveAs Filename:=FileSaveName 'Let user know you changed the file name. MsgBox "File saved under the following name..." & vbCr _ & FileSaveName, vbInformation, "Bill Made Me Do It" End If End Sub '================================================= ========================== ============= ' Counts the position in a string of a user provided character. ' Written by James Cone - September 2003. '================================================= ========================== ============= Function LASTPOSITION(ByRef strInput As String, _ ByRef strChar As String) As Long On Error GoTo WrongPosition Dim lngPos As Long Dim lngCnt As Long Dim lngLength As Long lngPos = 1 lngLength = Len(strChar) Do lngPos = InStr(lngPos, strInput, strChar, vbTextCompare) If lngPos Then lngCnt = lngPos lngPos = lngPos + lngLength End If Loop While lngPos 0 LASTPOSITION = lngCnt Exit Function WrongPosition: Beep LASTPOSITION = 0 End Function '================================================= ========================== ============= Regards, Jim Cone San Francisco, CA "Bill Oertell" wrote in message ... I'm having trouble getting this code to work. The dialog box come up and you can navigate to the directory you want, but the file still saves to the original file name in the original directory. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) a = MsgBox("Are sure you want to save this workbook?", vbYesNo) If a = vbNo Then Cancel = True Else SaveAsUI = True fileSaveName = _ Application.GetSaveAsFilename("TCR" & Cells(20, 29) & ".xls", fileFilter:="Excel Files (*.xls),*.xls") End If End sub What I want to do is force the user to save the file as TCR plus whatever is in cell AC20, ie TCRSomeone.xls, but I'd like them to be able to save it in the directory they choose. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Workbook_BeforeSave
Quite right Jim. Requirement is to force filename but be flexible on path:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Static blnSaving As Boolean Dim strFileName As String, strIdentifier As String, i As Long, j As Long If blnSaving Then blnSaving = False Else Cancel = True If MsgBox("Are sure you want to save this workbook?", vbYesNo) = vbYes Then strIdentifier = "TCR" & Cells(20, 29) & ".xls" strFileName = Application.GetSaveAsFilename(strIdentifier, fileFilter:="Excel Files (*.xls),*.xls") If strFileName < "False" Then i = 0: Do: j = i: i = InStr(i + 1, strFileName, Application.PathSeparator): Loop Until i = 0 blnSaving = True ThisWorkbook.SaveAs Mid(strFileName, 1, j) & strIdentifier End If End If End If End Sub "Jim Cone" wrote in message ... Bill, Building on the code that Rob provided, see if this does it for you... '============================================= Private blnWantToSave As Boolean Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) If blnWantToSave Then blnWantToSave = False Else Dim FileSaveName As String Dim lngPlace As Long If MsgBox("Are sure you want to save this workbook? ", _ vbYesNo + vbQuestion, "Question from Bill") = vbNo Then blnWantToSave = False Cancel = True Exit Sub Else Cancel = True FileSaveName = _ Application.GetSaveAsFilename("TCR" & Cells(20, 29).Value & _ ".xls",fileFilter:="Excel Files (*.xls),*.xls") End If 'Call function lngPlace = LASTPOSITION(FileSaveName, "\") 'Replace user specified file name with preferred name. FileSaveName = _ Left$(FileSaveName, lngPlace) & "TCR" & Cells(20, 29).Value & ".xls" blnWantToSave = True ActiveWorkbook.SaveAs Filename:=FileSaveName 'Let user know you changed the file name. MsgBox "File saved under the following name..." & vbCr _ & FileSaveName, vbInformation, "Bill Made Me Do It" End If End Sub '================================================= ========================== ============= ' Counts the position in a string of a user provided character. ' Written by James Cone - September 2003. '================================================= ========================== ============= Function LASTPOSITION(ByRef strInput As String, _ ByRef strChar As String) As Long On Error GoTo WrongPosition Dim lngPos As Long Dim lngCnt As Long Dim lngLength As Long lngPos = 1 lngLength = Len(strChar) Do lngPos = InStr(lngPos, strInput, strChar, vbTextCompare) If lngPos Then lngCnt = lngPos lngPos = lngPos + lngLength End If Loop While lngPos 0 LASTPOSITION = lngCnt Exit Function WrongPosition: Beep LASTPOSITION = 0 End Function '================================================= ========================== ============= Regards, Jim Cone San Francisco, CA "Bill Oertell" wrote in message ... I'm having trouble getting this code to work. The dialog box come up and you can navigate to the directory you want, but the file still saves to the original file name in the original directory. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) a = MsgBox("Are sure you want to save this workbook?", vbYesNo) If a = vbNo Then Cancel = True Else SaveAsUI = True fileSaveName = _ Application.GetSaveAsFilename("TCR" & Cells(20, 29) & ".xls", fileFilter:="Excel Files (*.xls),*.xls") End If End sub What I want to do is force the user to save the file as TCR plus whatever is in cell AC20, ie TCRSomeone.xls, but I'd like them to be able to save it in the directory they choose. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Workbook_BeforeSave
Your first problem is the GetSaveAsfilename does not save the file or
otherwise affect what the filename will be if it is saved. It mearly allows the user to select a filename and return the fully qualified filename (path and filename) as a string. You then have to save the file with your code. The easiest is to turn off events and overtly do the save with your desired filename to the selected path. I have used the GetSaveAsfilename approach, but this could allow the user to select a different name which is discarded (and could be misleading). You could put up the folder browser dialog although this takes much more code. (see reference at bottom of post). Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel As Boolean) Dim i as long, a as long, j as Long Dim sStr as String, sStr1 as String On Error goto ErrHandler a = MsgBox("Are sure you want to save this workbook?", vbYesNo) ' Cancel the save action initiated by the user Cancel = True If a = vbNo Then Else ' specify a worksheet - don't depend on which ' is visible unless it is ' a one sheet workbook sStr = "TCR" & worksheets(1).Cells(20,29).Value & ".xls" fileSaveName = Application.GetSaveAsFilename( _ sStr, fileFilter:="Excel Files (*.xls),*.xls") Application.EnableEvents = False if fileSaveName < "False" then i = len(FileSaveName) for j = i to 1 step -1 if mid(FileSaveName,j,1) = "\" then sStr1 = Left(FileSaveName,j) exit for end if Next Thisworkbook.SaveAs sStr1 & sStr else Thisworkbook.SaveAs ThisWorkbook.Path & "\" & sStr end if End If ErrHandler: Application.EnableEvents = True End sub for the folder browser dialog: John Walkenbach: Tip #29 http://www.j-walk.com/ss/excel/tips/tip29.htm -- Regards, Tom Ogilvy Bill Oertell wrote in message ... I'm having trouble getting this code to work. The dialog box come up and you can navigate to the directory you want, but the file still saves to the original file name in the original directory. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) a = MsgBox("Are sure you want to save this workbook?", vbYesNo) If a = vbNo Then Cancel = True Else SaveAsUI = True fileSaveName = Application.GetSaveAsFilename("TCR" & Cells(20, 29) & ".xls", fileFilter:="Excel Files (*.xls),*.xls") End If End sub What I want to do is force the user to save the file as TCR plus whatever is in cell AC20, ie TCRSomeone.xls, but I'd like them to be able to save it in the directory they choose. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Workbook_BeforeSave
Thanks, all for your answers. Rob's original code allows me to save the
file in any directory I want. My intent is to force a particular filename convention but allow a user the flexibility to save it in whatever directory they choose. The cell in the filename is the name of the first person that the form deals with, so the filename comes out as "TCRSomeone.xls". That way, when I see it in my records, I can more easily find a file. Thanks again! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
HELP!!!! Calling a sub from Workbook_BeforeSave | Excel Discussion (Misc queries) | |||
Workbook_BeforeSave() in xla | Excel Programming |