Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,290
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
HELP!!!! Calling a sub from Workbook_BeforeSave RocketMan[_2_] Excel Discussion (Misc queries) 4 May 31st 07 11:47 PM
Workbook_BeforeSave() in xla Bent Kjeldsen Excel Programming 6 September 24th 03 01:49 PM


All times are GMT +1. The time now is 02:46 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"