View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Jim Cone Jim Cone is offline
external usenet poster
 
Posts: 3,290
Default 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