Save Archive Once a Day

**Jiptastic** · 04-15-2013, 10:38 AM

I put the following code in the "this worksheet" section and it runs every time I open the spreadsheet. It saves an archive with the date and time, reopens the original and then closes the archive. I would like to program the macro to run upon open only if it hasn't been saved in 6 hours. Any ideas?

Private Sub Workbook_Open()

Resp = MsgBox("Save Archive? .", vbYesNo)

If Resp = vbYes Then

Dim wb As Workbook


'----Saving Part
Dim newFileName As String
Application.DisplayAlerts = False
    
    
       newFileName = "Fix It Report Archive" & Format(Now, " MM-DD HHMM") & ".xlsm"
       
    
ActiveWorkbook.SaveAs Filename:="M:\My Folder\Karen Postiglioni\JP\Template REPORTS\Tool Archives\\" & newFileName

 Workbooks.Open Filename:= _
        "M:\My Folder\Karen Postiglioni\JP\Template REPORTS\Template QA2.xlsm"
        
For Each wb In Workbooks
If Left(wb.Name, 21) = "Fix It Report Archive" Then
wb.Close
End If
Next

Application.DisplayAlerts = True
Windows("Template QA2").Activate

End If

End Sub

**AndyLitch** · 04-15-2013, 11:51 AM

Private Sub Workbook_Open()

If Now() < 0.25 * ThisWorkbook.Sheet1.Range("A1").Value Then Exit Sub

Resp = MsgBox("Save Archive? .", vbYesNo)

If Resp = vbYes Then

Dim wb As Workbook


'----Saving Part
Dim newFileName As String
Application.DisplayAlerts = False
    
    
       newFileName = "Fix It Report Archive" & Format(Now, " MM-DD HHMM") & ".xlsm"
       
    
ActiveWorkbook.SaveAs Filename:="M:\My Folder\Karen Postiglioni\JP\Template REPORTS\Tool Archives\\" & newFileName

 Workbooks.Open Filename:= _
        "M:\My Folder\Karen Postiglioni\JP\Template REPORTS\Template QA2.xlsm"
        
For Each wb In Workbooks
If Left(wb.Name, 21) = "Fix It Report Archive" Then
wb.Close
End If
Next

Application.DisplayAlerts = True
Windows("Template QA2").Activate
ThisWorkbook.Sheet1.Range("A1").Value = Now()

End If