Excel crashing problem when saving from VB

[thereverent]

I have been using an Excel sheet which has a VB form user front end.
It has a save option which uses one of the field names and puts a date
and time stamp in the filename.
Normally this works completely fine. However if you have saved a
version the previous day, make some changes and save it will hang. I
then have to use Task Manager to end Excel. Sometimes it creates a new
file with the new date/time stamp, sometime not.
But once a file has hung like this it becomes very flakly and will
hang if you go back into it and make minor changes (selecting
something different in a dropdown menu). The file becomes useless and
you have to start a new one. If it was just the save function that was
the problem I would know where to start to look, but as everything
seems to cause it to fail after the first crash I have no idea.
I am running Excel 2002 (SP3) on Win XP (SP2).

Any help would be most appreciated.

 

[Guest]

There may be some problem with the objects in your code.

It would be helpful to provide a copy of the routine where you save it.

 

[thereverent]

Public Sub btn_SAVE_Click()

Call SaveRoutine

End Sub

Public Sub SaveRoutine()
EmailError = 0
initialise = 1
On Error GoTo errorhandler

'get the current filepath and workbook name
fle = ActiveWorkbook.Name
filepath = Trim(ActiveSheet.Range("nme_filepath").Value)
If filepath = "" Then filepath = "U:\Incident Reports\" Else If
Right(filepath, 1) <> "\" Then filepath = filepath + "\"
ext = ".xls"

s = ctl_IR_ref

'insert a timestamp in to the filename after the datestamp

'if no data has been input in the Security+Client field, nor the
IT Incident Title field
'then save the file as 'Unnamed'. If there's no security
specified but an IT Incident Title
'save as the IT Incident Title
If s = "" Then s = Format(Date, "yyyymmdd") + "-Unnamed Incident"

'Add the .xls file extension
If Right(s, 4) <> ".xls" Then s = s + ext
'store the right hand half of the IR ref string
y = Right(s, Len(s) - 9)
'strip out the first 9 characters - ie the date and the hypen -
"20060101-"
s = Left(s, 9)
'insert the timestamp and then add the right-hand half of the IR
ref
currtime = Format(Time, "hh:mm")
temptime = Format(Time, "hh:mm")

s = s & currtime & "-" & y
'replace the colon used in the timestamp, otherwise an error will
occur upon saving
s = Format(Replace(s, ":", ""), ">")

'prompt the user to locate a filepath
response = Application.GetSaveAsFilename(filepath + s, , , "Please
select a save folder, any filename you input will not be used")
'if cancel clicked then exist save functionality

If response = "" Or response = False Then
initialise = 0: Exit Sub
Else
'loop through from the end to thr front chking for \ separate the
filepath and filename
x = Len(response)
Do Until Mid(response, x, 1) = "\" Or x <= 1
x = x - 1
Loop

filepath = Left(response, x)
End If
'plot the select filepath back in to the Excel sht for future saves
ActiveSheet.Range("nme_filepath").Value = filepath

If EmailError <> 1 Then

'check to see if the file already exists
'Set fs = CreateObject("Scripting.FileSystemObject")
fileexist = Dir(filepath & s, vbDirectory)

'if file doesn't exist then save it
If fileexist = "" Then
'plot the save date+Time
ActiveSheet.Range("nme_SaveDateTime") = Format(Date +
temptime, "dd/mmm/yyyy hh:nn")
ActiveWorkbook.SaveAs filepath & s
Else
'otherwise add a version number to the file name - loop round
and check that the new
'version controlled filename doesn't exist - if it does
continue to increment version no.
'until filename does not exist
'remove the .xls if there is one so a version number can be
saved.
If Right(s, 4) = ".XLS" Then s = Left(s, Len(s) - 4)

'set version to v2 and perform loop to identify filename not
already taken
versn = 1
'Set fs = CreateObject("Scripting.FileSystemObject")
Do Until fileexist = ""
versn = versn + 1
fileexist = Dir(filepath & s & "v" + Format(versn, "") +
ext, vbDirectory)
Loop
s = s & "v" & Format(versn, "") & ext

'plot the save date+Time
ActiveSheet.Range("nme_SaveDateTime") = Format(Date +
temptime, "dd/mmm/yyyy hh:nn")
ActiveWorkbook.SaveAs filepath & s
End If

'Inform user all is complete
response = MsgBox("Excel File: " & s & Chr(13) & " has been saved
to filepath: " & Chr(13) & filepath, 64, "File Saved")

Else
:
End If
EmailError = 0

'reset multi-list dropdowns as they loose their settings when save
Call Reset_multilist
initialise = 0

'set the saved property to true
ThisWorkbook.Saved = True
Exit Sub

errorhandler:
ErrMsg = "'Save Incident Report' functionality has been aborted.
The file may not have been saved correctly!"
EmailError = 1
Call errorhandling
Exit Sub


End Sub

 

[Guest]

I was picking up so references to the names on worksheets that should be ok.

I would recommend using option explicit to check your variables (ie declare
them first.)

Then step through the code using the debugger to find where you have some
problems.

One item I noted when you add (concatenate) strings together use & and not
+. it can cause problems.

sorry can't be much more help.

 

[thereverent]

Thanks for the ideas. Still having problems but have discovered
something.
The form works perfectly in Excel 2002 sp2 but will hang in sp3.
So a problem with the service pack rather than the code by the look of
it.