I am working on creating a template workbook that will be used on multiple projects. Each project will have their own folder and workbook, which can make it difficult to track them all down. Instead, I'm trying to create a BeforeSave event that will open another workbook and store this workbook's filepath on that workbook. The idea is that I can then call all saved workbooks to collect the data I need. I had it working, too, but I've encountered strange errors - workbook crashes and duplicate entries from the same event.
When the BeforeSave event is working, it adds 2-5 lines to the Project Collector instead of just once as expected. I've reviewed the code several times, but I don't see how or why it would repeat itself. It's not as if I'm pressing save multiple times, either, though the checks that I have should test for that anyway.
The main problem now is that lately the BeforeSave event will result in both workbooks forcibly closing. If the Project Collector workbook is closed the event will open the file, as expected, but it will crash before completion.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
Application.EnableEvents = False
Dim PrevFilePath As String
Dim NewFilePath As String
' turn off screen write to eliminate screen flicker
Application.ScreenUpdating = False
If Sheets("Sheet5").Range("D70") <> Application.ActiveWorkbook.FullName And _
Application.ActiveWorkbook.FullName <> "filepath\filename of template.xlsm" _
Then 'if filepath or filename have changed since last opened, also does not trigger on the template file.
PrevFilePath = Sheets("Sheet5").Range("D70") 'store the previous filepath
NewFilePath = Application.ActiveWorkbook.FullName 'store the current filepath
Sheets("Sheet5").Range("D70") = Application.ActiveWorkbook.FullName 'write the current filepath on this workbook
GoTo UpdateProjectCollector
Else
End If
DoEvents
UpdateProjectCollector:
'open Project Collector
Workbooks.Open "\\filepath\Project Collector.xlsm" 'open Project Collector
If Workbooks("Project Collector.xlsm").Sheets("Sheet1").Range("A:A").Find(PrevFilePath) Is Nothing Then
Workbooks("Project Collector.xlsm").Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = NewFilePath
Else: Workbooks("Project Collector.xlsm").Sheets("Sheet1").Range("A:A").Replace What:=PrevFilePath, Replacement:=NewFilePath 'replace the previous filepath w/ the new filepath
End If
DoEvents
Workbooks("Project Collector").Close SaveChanges:=True 'save & close Project Collector
' turn screen write back on
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Online resources suggested that perhaps one of the files is corrupted. I tried using the Open -> Open & Repair when opening a workbook, although that had no affect.
I re-created the Project Collector workbook entirely. I meant to save the code I had written for it, but forgot about it, and had to rewrite that book's code. This had no affect on the original workbook's ability to add its filepath to the Project Collector workbook.
I created a separate workbook where pressing a Command Button opens the Project Collector file and adds text 1 row below the bottom, just like with the original workbook - and it worked! This, combined with the fact that it was working before, suggests to me that it may not be the code, at least not in an obvious way.
I don't use 3rd party add-ins, and am only using the default references (Visual Basic For Applications, Microsoft Excel 16.0 Object Library, OLE Automation, Microsoft Office 16.0 Object Library, Microsoft Forms 2.0 Object Library).
I'd be happy to hear of any solutions that don't result in a force close.
Commenting here to resolve this thread. The PrevFilePath value was blank by default, and often what I used during testing. I added a check to determine if PrevFilePath = "", which will skip the .Find(PrevFilePath) and instead just write to the bottom-most row, just as if .Find(PrevFilePath) returns nothing. Before, it wouldn't add the filepath and it wouldn't replace anything because technically it was able to .Find blank cells in that range. Crashes have stopped as well.