Hi Paul - sorry, had a busy day today doing my actual job so have had to wait until I get home to look at this again.
I commented out the sPath=Pending Path bit and it ALMOST works!
I don't understand what the advantage is of making the Approved version save as plain XLSX? It means that the user gets the error message that "the following features cannot be saved in macro-free workbooks, click yes or no" - if they click NO they get a 400 error message, but if they click YES it saves it where you would hope and all is dandy. That error message (for a non-excel user especially) is kind of frightening and a bit off putting, though?
However, the issue really comes if your a Budget Holder and go straight for the Approved option in the original Expenditure form - if you click YES to the error message, it saves the Approved version but OVERWRITES the original Expenditure version as plain XLSX, thereby removing the macros etc for future users? I mean, please don't get me wrong, I'm impressed it no longer deletes it but really need the original Expenditure form to remain as an XLSM file, ready for the next person who needs to use it.
So, I have tried to fix it myself (are you impressed - I am!?!), by changing
sPath = Left(sPath, i) & "xlsx"
to
sPath = Left(sPath, i) & "xlsm"
and changing the FileFormat to MacroEnabled, and this means that, if the user follows the Pending then Approve path, then it works - no error messages, no warnings about file format. Brilliant! Unfortunately, though, if they go straight for Approve, all it does it save the original Expenditure form and nothing else - no Approved file?
Fell like I'm going round and round in circles!
This is what it looks like now (you'll see I've set this up to go work on my PC at home, so it's now pointing at my C drive, just so I can keep trying whilst I'm not at work!
Option Explicit
'Const sDocumentPath As String = "M:\Budgets Family Centre Service\2019-20\" 'wherever you want to save the file
Const sDocumentPath As String = "c:\users\trace\onedrive\documents\work\" 'wherever you want to save the file
Const sPendingFolder As String = "Pending Approval\"
Const sApprovedFolder As String = "Approved Purchase\"
'Sub test()
' MsgBox PendingPath & vbCrLf & vbCrLf & ApprovedPath
'End Sub
' M:\Budgets Family Centre Service\2019-20\Pending Approval\TheUser\06-01-2019_PendingExpenditure.xlsm
Function PendingPath() As String
PendingPath = sDocumentPath & sPendingFolder & Environ("Username") & "_" & Format(Date, "dd-mmm-yy") & "_PendingExpenditure.xlsm"
End Function
'Assumes Thisworkbook.FullName =
' M:\Budgets Family Centre Service\2019-20\Pending Approval\TheUser\06-01-2019_PendingExpenditure.xlsm
Function ApprovedPath() As String
Dim sPath As String
Dim i As Long
sPath = ThisWorkbook.FullName
'sPath = PendingPath ' for testing --------------------------------------------------------<<<<<
sPath = Replace(sPath, sPendingFolder, sApprovedFolder)
sPath = Replace(sPath, "PendingExpenditure", "ApprovedPurchase")
i = InStrRev(sPath, ".")
sPath = Left(sPath, i) & "xlsm"
ApprovedPath = sPath
End Function
Sub SaveDocumentPending()
ActiveWorkbook.SaveAs Filename:=PendingPath, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
End Sub
'assumes workbook name something like
' M:\Budgets Family Centre Service\2019-20\Pending Approval\TheUser\06-01-2019_PendingExpenditure.xlsm
Sub SaveDocumentApproved()
Dim sNewPath As String, sOldPath As String
sOldPath = ThisWorkbook.FullName
sNewPath = ApprovedPath
ActiveWorkbook.SaveAs Filename:=sNewPath, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
On Error Resume Next
Application.DisplayAlerts = False
Kill sOldPath
Application.DisplayAlerts = True
On Error GoTo 0
ActiveWorkbook.Close
End Sub