before_save problems
 

Hi, i have written this peace of code for my project. i have just
started to learn VBA. This code saves my file with the given name to
the correct folder and then the cursor is busy for 10 seconds and then
gives me that "recover my file and open again..." error and then the
application is being closed. and it askes me if i want to send the
error to MS or not.
also i am not sure if it tries to save the file twice.
I tried to find out what the problem is but i couldn't. Would sobmody
please help me?

i have a validation list in C9 and depending on the user's choice some
other cells should be filled out.
on sheet2 i have my named ranges and cells that keep the filepath and
filename and so on.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim i, j As Integer
Dim cell As Range
Dim filename As Variant
Dim Path As String

j = 0
'find # of colored cells:
Sheets(1).Range("a1:j55").Select
For Each cell In Selection
If cell.Interior.ColorIndex = 19 Then
j = j + 1
End If
Next cell

If j = 0 Then
Range("c5").Select
Cancel = True
MsgBox "To print a blank form please use the Blank Form button."
ThisWorkbook.Saved = True
Exit Sub
End If

i = 0
'find # of colored cells that are empty:
Sheets(1).Range("a1:j55").Select ' lots of merged cells in this
selection
For Each cell In Selection
If cell.Interior.ColorIndex = 19 Then
If cell.Value = "" Then
i = i + 1
End If
End If
Next cell
Range("c5").Select
If i 0 Then
MsgBox "Please fill out all the mandatory fields which are colored
in yellow."
Exit Sub
'Cancel = True
Else
On Error Resume Next
MkDir ("C:\ABCD")
MkDir ("C:\ABCD\site" & Sheets(1).Range("c5").Value)
On Error GoTo 0

On Error GoTo ErrHandler
Application.EnableEvents = False

'clear the cells that shouldnt have anything in them:

Sheets(1).Range("d22,f22,h22,j22,d26,i26,g27,h28,d 32,h32,c36,d37,h37,f38,b41:b45").Select
For Each cell In Selection
If cell.Interior.ColorIndex < 19 Then
cell.Value = ""
Range("c5").Select
End If
Next cell
'save the file :
If (Dir(Sheets(2).Range("h1") & Sheets(2).Range("e1") & ".xls") =
"") Then
ThisWorkbook.SaveAs filename:=Sheets(2).Range("h1") &
Sheets(2).Range("e1") & ".xls"
MsgBox Sheets(2).Range("e1").Value & "'s file has been saved to
" & Sheets(2).Range("g1").Value
Else
ThisWorkbook.Save
End If
ErrHandler:
Application.EnableEvents = True
End If
Exit Sub ' i added this so maybe after saving it exits the sub and
won't do anything else but it seems not to be working
End Sub

before_save problems
 

For starters, remove the ( ) in the MkDir statements...
MkDir "C:\ABCD"
MkDir "C:\ABCD\site" & Sheets(1).Range("c5").Value

Also, do not use On Error Resume Next when you are
developing code as it hides your mistakes.
(as you have discovered)

It appears that you create the directory every time the code runs.
You need to check if the directory exists and if not run the code.

For what's it's worth:
peace - absence of war
piece - part of something.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Nasim"
wrote in message
Hi, i have written this peace of code for my project. i have just
started to learn VBA. This code saves my file with the given name to
the correct folder and then the cursor is busy for 10 seconds and then
gives me that "recover my file and open again..." error and then the
application is being closed. and it askes me if i want to send the
error to MS or not.
also i am not sure if it tries to save the file twice.
I tried to find out what the problem is but i couldn't. Would sobmody
please help me?

i have a validation list in C9 and depending on the user's choice some
other cells should be filled out.
on sheet2 i have my named ranges and cells that keep the filepath and
filename and so on.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim i, j As Integer
Dim cell As Range
Dim filename As Variant
Dim Path As String

j = 0
'find # of colored cells:
Sheets(1).Range("a1:j55").Select
For Each cell In Selection
If cell.Interior.ColorIndex = 19 Then
j = j + 1
End If
Next cell

If j = 0 Then
Range("c5").Select
Cancel = True
MsgBox "To print a blank form please use the Blank Form button."
ThisWorkbook.Saved = True
Exit Sub
End If

i = 0
'find # of colored cells that are empty:
Sheets(1).Range("a1:j55").Select ' lots of merged cells in this
selection
For Each cell In Selection
If cell.Interior.ColorIndex = 19 Then
If cell.Value = "" Then
i = i + 1
End If
End If
Next cell
Range("c5").Select
If i 0 Then
MsgBox "Please fill out all the mandatory fields which are colored
in yellow."
Exit Sub
'Cancel = True
Else
On Error Resume Next
MkDir ("C:\ABCD")
MkDir ("C:\ABCD\site" & Sheets(1).Range("c5").Value)
On Error GoTo 0

On Error GoTo ErrHandler
Application.EnableEvents = False

'clear the cells that shouldnt have anything in them:

Sheets(1).Range("d22,f22,h22,j22,d26,i26,g27,h28,d 32,h32,c36,d37,h37,f38,b41:b45").Select
For Each cell In Selection
If cell.Interior.ColorIndex < 19 Then
cell.Value = ""
Range("c5").Select
End If
Next cell
'save the file :
If (Dir(Sheets(2).Range("h1") & Sheets(2).Range("e1") & ".xls") =
"") Then
ThisWorkbook.SaveAs filename:=Sheets(2).Range("h1") &
Sheets(2).Range("e1") & ".xls"
MsgBox Sheets(2).Range("e1").Value & "'s file has been saved to
" & Sheets(2).Range("g1").Value
Else
ThisWorkbook.Save
End If
ErrHandler:
Application.EnableEvents = True
End If
Exit Sub ' i added this so maybe after saving it exits the sub and
won't do anything else but it seems not to be working
End Sub

before_save problems
 

Sorry, I spoke before I thought.
The "()" in MkDir doesn't affect whether it works or not
Jim Cone
San Francisco, USA


"Jim Cone"
wrote in message
For starters, remove the ( ) in the MkDir statements...
MkDir "C:\ABCD"
MkDir "C:\ABCD\site" & Sheets(1).Range("c5").Value

Also, do not use On Error Resume Next when you are
developing code as it hides your mistakes.
(as you have discovered)

It appears that you create the directory every time the code runs.
You need to check if the directory exists and if not run the code.

For what's it's worth:
peace - absence of war
piece - part of something.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

before_save problems
 

Here is your code with some cleaning and modification.
I have no way of testing it, as I don't know the values in the
various cells that you use to construct the path and file name.
Note that I deleted the declaration for "filename", as that is the
name of the argument in the SaveAs code and should not be declared.
"Cancel = True" was added in a couple of places, to prevent
Excel from saving the workbook upon exit.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
On Error GoTo ErrHandler
Dim i As Integer
Dim j As Integer
Dim cell As Excel.Range
Dim strPath As String

j = 0
'find # of colored cells:
For Each cell In Sheets(1).Range("a1:j55").Cells
If cell.Interior.ColorIndex = 19 Then
j = j + 1
End If
Next cell

If j = 0 Then
Sheets(1).Range("c5").Select
MsgBox "To print a blank form please use the Blank Form button."
Cancel = True
Exit Sub
End If

i = 0
'find # of colored cells that are empty:
' lots of merged cells in this Selection
For Each cell In Sheets(1).Range("a1:j55")
If cell.Interior.ColorIndex = 19 Then
If cell.Value = "" Then
i = i + 1
End If
End If
Next cell

If i 0 Then
MsgBox "Please fill out all the mandatory fields which are colored in yellow."
Cancel = True
Exit Sub
Else
On Error Resume Next
MkDir "C:\ABCD"
MkDir "C:\ABCD\site" & Sheets(1).Range("c5").Value
On Error GoTo ErrHandler
Application.EnableEvents = False

'clear the cells that shouldnt have anything in them:
For Each cell In Sheets(1).Range _
("d22,f22,h22,j22,d26,i26,g27,h28,d32,h32,c36,d37, h37,f38,b41:b45").Cells
If cell.Interior.ColorIndex < 19 Then
cell.Value = vbNullString
Range("c5").Select
End If
Next cell

'save the file :
strPath = Sheets(2).Range("h1").Value & Sheets(2).Range("e1").Value & ".xls"
If (Dir(strPath) = "") Then
ThisWorkbook.SaveAs Filename:=strPath
MsgBox Sheets(2).Range("e1").Value & "'s file has been saved to" & _
Sheets(2).Range("g1").Value
Cancel = True
Else
ThisWorkbook.Save
Cancel = True
End If
End If
ErrHandler:
Application.EnableEvents = True
End Sub
'-------------



"Jim Cone"
wrote in message
Sorry, I spoke before I thought.
The "()" in MkDir doesn't affect whether it works or not
Jim Cone
San Francisco, USA



"Jim Cone"
wrote in message
For starters, remove the ( ) in the MkDir statements...
MkDir "C:\ABCD"
MkDir "C:\ABCD\site" & Sheets(1).Range("c5").Value

Also, do not use On Error Resume Next when you are
developing code as it hides your mistakes.
(as you have discovered)

It appears that you create the directory every time the code runs.
You need to check if the directory exists and if not run the code.

For what's it's worth:
peace - absence of war
piece - part of something.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

before_save problems
 

Hi Jim,
Thanks a lot for your help. I copied your codes and it works fine.
I laughed alot about that "peace" thing :) Aabviosley English is not my
first language. Thanks for mentioning that. It is good to have sombody
correcting you whenever you make a mistake because most of the time you
don't know what your mistakes are.
Anyway. Thanks again for your time and effort.
Nasim