Frage

I am having a lot of difficulty getting a SaveAs command to work properly. For a local hospital, there are patient charts which are created from a template file, in which patient data is entered after which it is manually renamed (using save-As) and then copied to another location as a backup. The template is re-used over and over again.

The goal of my code is this to automate this process. Therefore I want to save to two different locations, starting from a template file. The template file should not be overwritten. In the template, a user sets the department name and bed number in cell K1 and N1 , repectively. These fields determine the folder and filename within that folder.

When the save button is pressed, my code starts to run. I use SaveCopyAs to save the backup file and after that I want to use SaveAs to save to my primary folder. SaveAs should set this new file to be my working file, therefore not overwriting my template. At least this is what I believe...

THE PROBLEM: When running SaveAs, Excel crashes (without any clear error message). The strange thing (to me) is that is does not crash when I replace SaveAs with SaveCopyAs.

THE QUESTION: Why does Excel crash at this point? Is there a way to fix or avoid this behaviour? I cannot find a suitable solution that does not alter my template. Any help or suggestions are more than welcome.

The code below is placed in my "ThisWorkbook" folder and is executed every time I click the "save"-button.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    department = Range("K1").Value 'Name of department: CHIC, THIC, ICB or NCIC
    bedNumber = Range("N1").Value 'bednumber or roomnumber: Bed 1. Bed 2 or Room 1, Room 2.
    newFileName = department & "\" & bedNumber & ".xls"

    If IsEmpty(department) Then
        MsgBox "You haven't entered a department. Please try again."
    ElseIf IsEmpty(bedNumber) Then
        MsgBox "You haven't entered a bed or room number. Please try again."
    Else
        ActiveWorkbook.SaveCopyAs "C:\myBackupFolder\" + newFileName
    End If


    ActiveWorkbook.SaveAs "C:\myPrimaryFolder\" + newFileName 'Doesn't work

    'ActiveWorkbook.SaveCopyAs "C:\myPrimaryFolder\" + newFileName 'Does work, but I end up with a messed up template!
End Sub
War es hilfreich?

Lösung

As well as setting Cancel = True to prevent the default save-behaviour, add:

Application.EnableEvents = False
ActiveWorkbook.SaveAs "C:\myPrimaryFolder\" + newFileName 'Doesn't work
Application.EnableEvents = True

to prevent the same procedure being called again (and again..). This is probably why it crashes.

Lizenziert unter: CC-BY-SA mit Zuschreibung
Nicht verbunden mit StackOverflow
scroll top