Dr. Demento
Well-known Member
- Joined
- Nov 2, 2010
- Messages
- 620
- Office Version
- 2019
- 2016
- Platform
- Windows
I have a change log for Personal.xlsb (many thanks to MrExcel gurus!). It works fine, but I'd like to reformat it (see current/desired here).
I'd basically like the output to go from one cell with three pieces of data (author/time/date) to the same data in three separate cells, all on the same line.
If someone can point me in the right direction, I don't mind tinkering; I either A) don't know what to search for or B) am not recognizing code from others that does this. It's Monday somewhere, right??![Oops! :banghead: :banghead:](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f633.png)
Thanks y'all!
I'd basically like the output to go from one cell with three pieces of data (author/time/date) to the same data in three separate cells, all on the same line.
If someone can point me in the right direction, I don't mind tinkering; I either A) don't know what to search for or B) am not recognizing code from others that does this. It's Monday somewhere, right??
![Oops! :banghead: :banghead:](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f633.png)
Thanks y'all!
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' http://www.mrexcel.com/forum/excel-questions/864085-backing-up-personal-xlsb-using-visual-basic-applications.html#post4196704#2 & #14
Dim wb As Workbook
Set wb = Workbooks("Personal.xlsb")
Dim strBakPath As String
Dim fsoFSO
Set fsoFSO = CreateObject("Scripting.FileSystemObject")
With Application ' https://msdn.microsoft.com/en-us/library/office/ff835544.aspx
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.DisplayStatusBar = False
End With
' Builds an on going list of who saved file when.
' Code must go into the "ThisWorkbook" module!
' All data is placed in column "A" adjust width and formats.
' http://www.mrexcel.com/forum/excel-questions/24014-visual-basic-applications-macro-tell-who-last-saved-file-when.html#9
With wb.Worksheets("Sheet1")
.Range("A1") = "Change Log: " & wb.Name
.Range("A2") = "Created by: " & Left(wb.BuiltinDocumentProperties("Author"), _
FindNthChar(" ", wb.BuiltinDocumentProperties("Author"), 2) - 1) & chr(10) & _
"Created on: " & Format(wb.BuiltinDocumentProperties("Creation Date"), "mm/dd/yyyy" & " || " & "hh:mm")
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
"Last Author: " & Left(wb.BuiltinDocumentProperties("Last Author"), _
FindNthChar(" ", wb.BuiltinDocumentProperties("Last Author"), 2) - 1) & chr(10) & _
"Last Saved: " & Format(wb.BuiltinDocumentProperties("Last Save Time"), "mm/dd/yyyy" & " || " & "hh:mm")
.UsedRange.RemoveDuplicates Columns:=Array(1), Header:=xlYes ' https://msdn.microsoft.com/en-us/library/office/ff193823.aspx
End With
If Application.StartupPath = "\\AppData\Roaming\Microsoft\Excel\XLSTART" Then
strBakPath = "\\Documents\References\Computer Hacks\MS Office Hacks\Excel\Personal_xlsb\Archived PERSONAL.XLSB Files\"
Else
strBakPath = Application.StartupPath & "\Archive\"
If fsoFSO.FolderExists(strBakPath) Then
GoTo SaveFile
Else
fsoFSO.CreateFolder (strBakPath)
End If
End If
SaveFile:
With Workbooks("PERSONAL.xlsb")
.SaveCopyAs strBakPath & "PERSONAL.xlsb" & Format(Now, "_yyyymmdd_hhmm.bak")
.Save
End With
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.DisplayStatusBar = True
End With
End Sub