VBA Code to count how many time a workbook is opened

=IF(

New Member
Joined
Apr 20, 2010
Messages
27
Hey Everyone!

Just wanted to ask all the VBA gurus if they would know how to put the number of times (i.e. in Sheet 1, Range A1) a Workbook is opened.

I then want to basically have the code delete every sheet if ithe count is > 50.

Possible?

Thanks in advance!
 
Hi,

Paste this code in the Thisworkbook Object ( aka module ) while in VBE

Let us know :)

******************* CODE **********************

Private Sub Workbook_open()
'Greet the user
MsgBox "Hello " & Application.UserName

'Get setting from registry
Counter = GetSetting("XYZ Corp", "Budget", "Count", 0)
LastOpen = GetSetting("XYZ Corp", "Budget", "Opened", "")
'Display the information
msg = "This file has been opened " & Counter & " times."
msg = msg & vbCrLf & "Last opened: " & LastOpen
MsgBox msg, vbInformation, ThisWorkbook.Name
'Update information and store it
Counter = Counter + 1
LastOpen = Date & " " & Time
SaveSetting "XYZ Corp", "Budget", "Count", Counter
SaveSetting "XYZ Corp", "Budget", "Opened", LastOpen

'Keep track of who opens this workbook
'Open ThisWorkbook.Path & "\usage.log" For Append As #1
'Print #1, Application.UserName, Now
'Close #1

End Sub
 
Upvote 0
Very possible, although I'm slightly suspicious that someone is trying to plant a time-bomb... but try this in your ThisWorkbook code module:-
Code:
Option Explicit
 
Private Sub Workbook_Open()
 
  Dim ws As Worksheet
  Dim wsFound As Boolean
  
  wsFound = False
  For Each ws In Worksheets
    If ws.Name = "Hidden" Then
      wsFound = True
      Exit For
    End If
  Next ws
  If Not wsFound Then
    Sheets.Add.Name = "Hidden"
    Sheets("Hidden").Visible = xlVeryHidden
  End If
  
  Sheets("Hidden").Range("A1") = Sheets("Hidden").Range("A1") + 1
  ActiveWorkbook.Save
  If Sheets("Hidden").Range("A1").Value > 50 Then
    Sheets("Hidden").Visible = xlHidden
    Sheets.Add.Name = "NewEmptySheet"
    For Each ws In Worksheets
      If ws.Name <> "NewEmptySheet" Then
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
      End If
    Next ws
    Sheets("NewEmptySheet").Name = "Sheet1"
    ActiveWorkbook.Save
  End If
  
End Sub
 
Upvote 0
One issue you will encounter is that if a user disables Macros then this routine wont run and they will be able to open as many times as they like.

To get around this in the past I have included a header sheet stating that macros need to be enable to view, with the data sheets hidden and protected.

In the macro suggested by silentbhudda above you would include some code to hide the header sheet and unhide/unprotect the data sheets
 
Upvote 0
Tony, you are correct, and of course my solution suffers from the same drawback.
 
Upvote 0
Hey thanks everyone for your solutions!

Ruddles...what do you mean by time-bomb? Sounds like you think it's a bad thing...not sure what you mean?

The aim is to get a user to only have a limited amount of times they can access the workbook. It's like a teaser if that makes sense. I guess time bomb is probably the right way of thinking of it...
 
Upvote 0
A time bomb is something hidden which goes off after a while and causes damage. It has been known for disgruntled employees to leave code in databases and workbooks which requires them to refresh some sort of timer periodically and if they fail to do so - because they've been dismissed for incompetence, I should imagine - the code kicks in and corrupts data, deletes records, etc. This is highly illegal in most countries!

Rather than delete all the worksheets you could make them xlVeryHidden - that way they'd be recoverable if necessary. Of course, you know what you're trying to do so the decision is entirely yours.
 
Upvote 0
Thanks for the code. It works. Thank you!!!.
How can I keep track of the user log that is appears as message in your code in a sheet within the workbook. I need to know who is opening the workbook.
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top