Excel has stopped reading personal.xlsb at startup

[RichardatRedditch]

To my complete surprise, Excel seems to have stopped reading the personal.xlsb at startup, giving me a dreadful " Oh ****" shock when I went to use a macro and found that there were non showing when I clicked on "macros" in the ribbon. I have found that if I manually open C:\Users\Richard\AppData\Roaming\Microsoft\Excel\XLSTART\personal.xlsb all the macros are there (thank goodness!)

So far I have looked at file>options>addins>disabled items, and no disabled thing is there.
I have added C:\Users\Richard\AppData\Roaming\Microsoft\Excel\XLSTART to the list of trusted locations in file>options>Trust Centre, but to no effect.
I have also tried making a change in one of the macros, and re-saving personal.xlsb in to the XLSTART folder but again to no effect.

Is there anything else I can try, before I am forced to re-install Excel itself (which I don't want to do)?
I am running Excel 2013 on a W7 pro 64bit machine.
Help would be appreciated!
Richard

 

[Dr. Demento]

This might be overkill, but sometimes I get carried away with what I can do

My solution is not automatic like Jim's suggestion but I can't run scripts at work. However, when Excel freezes and I have to kill it without saving, I do occasionally lose that backup (however, the original Personal.xlsb file is still intact).

hth

In the code of the ThisWorkbook sheet in Personal.xlsb, I have the three bits of code -- the trigger (#1), the log/backup function (#2) and the auxilary assist files (#3):

#1 Trigger backup with each MANUAL Save of personal.xlsb file

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

#2 Log/backup function

Requires Worksheet.Name = "Log" with Table.Name = "tbl_Log" with header at A5:C5

Private Sub personal_Backup()
' [URL]http://www.mrexcel.com/forum/excel-questions/864085-backing-up-personal-xlsb-using-visual-basic-applications.html#post4196704#2[/URL] & #14
  
Dim wbk As Workbook
  Set wbk = Workbooks("Personal.xlsb")
Dim shtLog As Worksheet
  Set shtLog = wbk.Worksheets("Log")
Dim tblLog As ListObject
  Set tblLog = shtLog.ListObjects("tbl_Log")
Dim pvt As PivotTable
  Set pvt = shtLog.PivotTables("pvt_Log")
Dim FSO
  Set FSO = CreateObject("Scripting.FileSystemObject")
Dim strBakPath As String
OptimizeVBA True


[B][COLOR=#800080]' ### If you aren't interested in the Logging function, delete code between two lines surrounded by ### (triple hashtags) -- the two subs that start with [U][I]tbl_[/I][/U] can also be deleted[/COLOR][/B]
' Builds an on going list of who saved file when.
' Code must go into the "ThisWorkbook" module of Personal.xlsb!
' All data is placed in column "A" adjust width and formats.
' [URL]http://www.mrexcel.com/forum/excel-questions/24014-visual-basic-applications-macro-tell-who-last-saved-file-when.html#9[/URL]
  With shtLog
    .Range("A1") = "Change Log: " & wbk.Name
    .Range("A2") = "Created By"
    .Range("B2") = "Created On"
    .Range("A3") = Left$(wbk.BuiltinDocumentProperties("Author"), _
                      find_NthChar(" ", wbk.BuiltinDocumentProperties("Author"), 2) - 1)
    .Range("B3") = Format(wbk.BuiltinDocumentProperties("Creation Date"), "mm/dd/yyyy")
    .Range("C3") = Format(wbk.BuiltinDocumentProperties("Creation Date"), "hh:mm")
    .Range("A5") = "Last Author"
    .Range("B5") = "Last Saved"

    ' ~~ Log folder location of current file
    .Hyperlinks.Add .Range("F1"), file_Path(wbk.FullName)
      ' ~~ Excel version: '=SUBSTITUTE( LEFT(CELL("filename",A1),FIND("]",CELL("filename",A1))-1),"[","") || _
                           [URL]https://exceljet.net/formula/get-workbook-name-and-path-without-sheet[/URL]
    
    ' ~~ Place Last Author and last time saved (date | time) into log table
    tbl_addNewRow tblLog
    tbl_addData lbt:=tblLog, _
                rtsdata:=Left$(wbk.BuiltinDocumentProperties("Last Author"), _
                         find_NthChar(" ", wbk.BuiltinDocumentProperties("Last Author"), 2) - 1), _
                col:=1
    tbl_addData lbt:=tblLog, _
                rtsdata:=Format(wbk.BuiltinDocumentProperties("Last Save Time"), "mm/dd/yyyy"), _
                col:=2
    tbl_addData lbt:=tblLog, _
                rtsdata:=Format(wbk.BuiltinDocumentProperties("Last Save Time"), "hh:mm"), _
                col:=3
    
    ' ~~ Remove duplicate log entries
    .Range("tbl_Log[#All]").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes  ' [URL]https://msdn.microsoft.com/en-us/library/office/ff193823.aspx[/URL]
    ' ~~ Refresh pvt tracking personal updates
    .PivotTables("pvt_Log").PivotCache.Refresh
  End With
[COLOR=#800080]
[B]' ### End Logging function ###[/B][/COLOR]

  If Application.StartupPath = [COLOR=#0000ff][I][B]Desktop path [where Personal.xlsb is located; see: [URL="http://wheatblog.com/2011/08/where-is-the-excel-personal-macro-workbook-located/"]Where is the Excel Personal Macro Workbook Located? – wheatblog[/URL]][/B][/I][/COLOR] Then
    strBakPath = [COLOR=#0000ff][I][B]Desktop BACKUP path ' [update to your specific paths as Strings][/B][/I][/COLOR]
  Else
    strBakPath = Application.StartupPath & "\Archive"  ' For laptop, other computers
    
    If FSO.FolderExists(strBakPath) Then
      GoTo SaveFile
    Else
      FSO.CreateFolder (strBakPath)
    End If
    
  End If
  
SaveFile:
  With Workbooks("PERSONAL.xlsb")
    .SaveCopyAs strBakPath & "PERSONAL.xlsb" & Format(Now, "_yyyymmdd[COLOR=#ff0000][B]_hhmm[/B][/COLOR].bak")  [COLOR=#ff0000]<-- If you don't want to have multiple copies per day, eliminate the '_hhmm' section and you will only have one backup per day.[/COLOR]
    .Save
  End With
  
OptimizeVBA False
  
End Sub

#3 Auxilary assist code

Private Sub OptimizeVBA(isOn As Boolean)
' ~~ Procedure for increasing VBA performance
' [URL="http://analystcave.com/excel-improve-vba-performance/"]Guide to Improving VBA Performance. Faster Excel VBA[/URL]
'  Excel VBA Performance Coding Best Practices: Turn off some Excel functionality so your code runs faster
'  [URL]http://blogs.office.com/2009/03/12/excel-vba-performance-coding-best-practices/[/URL]

On Error Resume Next
    With Application
      .ScreenUpdating = Not (isOn)
      .Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)  ' ~~ Original statement; throws error when opening Excel
      ' [URL]http://www.mrexcel.com/forum/excel-questions/912050-intermittent-error-application-calculation.html#4[/URL]
      .EnableEvents = Not (isOn)
      .DisplayAlerts = Not (isOn)
      .DisplayStatusBar = Not (isOn)
      .PrintCommunication = Not (isOn)
    End With
    ActiveSheet.DisplayPageBreaks = Not (isOn)
On Error GoTo 0
End Sub

Private Function file_Path(rtsPathFile As String) As String
' ~~ Given a full path and file, strip the filename off the end and return the path
' [URL="http://stackoverflow.com/a/13409537"]vba - Find the directory part (minus the filename) of a full path in access 97 - Stack Overflow[/URL]
Dim filesystem As Object
Set filesystem = CreateObject("Scripting.FilesystemObject")
  file_Path = filesystem.GetParentFolderName(rtsPathFile) & ""
End Function

Private Sub tbl_addNewRow(ByVal lbt As ListObject)
' ~~ Add new row to table
' [URL="http://stackoverflow.com/a/14591924"]Excel VBA - Function or sub to add new row and data to table - Stack Overflow[/URL]Dim cntr As Long
  If lbt.ListRows.count > 0 Then
    For cntr = 1 To lbt.ListColumns.count
      If Trim(CStr(lbt.DataBodyRange(lbt.ListRows.count, cntr).value)) <> vbNullString Then  ' [URL="http://stackoverflow.com/a/17575380"]Looping through all rows in a table column, Excel-VBA - Stack Overflow[/URL]
        lbt.ListRows.Add
        Exit For
      End If
    Next cntr
  ElseIf lbt.ListRows.count = 0 Then
    lbt.ListRows.Add
  End If
End Sub

Private Sub tbl_addData(ByVal lbt As ListObject, _
                                    ByVal rtsdata As String, _
                                    ByVal col As Integer)
' ~~ Add new row and data to table
' [URL="http://stackoverflow.com/a/14591924/5533577"]Excel VBA - Function or sub to add new row and data to table - Stack Overflow[/URL]
 
  'First check if the last row is empty; if not, add a row
  If lbt.ListRows.count > 0 Then
    If col <> lbt.ListColumns.count Then
      lbt.DataBodyRange(lbt.ListRows.count, col) = rtsdata
    ElseIf col = lbt.ListColumns.count Then
      lbt.DataBodyRange(lbt.ListRows.count, col) = rtsdata
      lbt.ListRows.Add
    End If
  End If
End Sub

 

[jimrward]

OK here is my skinny batch file, add and modify accordingly

copy "C:\Documents and Settings\Jim\Application Data\Microsoft\Excel\XLSTART\*.*" F:\VbaSave\*.*

copy "C:\Documents and Settings\Jim\Application Data\Microsoft\Outlook\*.*" F:\VbaSave\*.*

do a google for gpedit.msc and logoff scripts see previous post for some details, right click the logoff choose properties and hook up the dos batch file above

 

[RichardatRedditch]

Hello Dr. Demento and Jim

Just back from a few days away. Thank you so much for your help, and your time in preparing these responses to my query. Quite a lot for me to get my head around, but it will be well worth it at the end ...

Best wishes

Richard

 

[Dr. Demento]

Glad to help. I hope one of our solutions fits your needs.

Take care.