Excel VBA Self-Destruct Switch - vba

I have had my first "Client-took-my-work-and-then-ghosted-me-without-paying" experience. For the future, I want to put in a killswitch, disguised as a regular macro, which makes the whole thing unusable. That way, even if they hire someone to crack the password and remove my "Your trial has expired..." check, a normal-looking macro (Something like "Fix_Sheet_Formatting") would be easily overlooked and run, destroying everything and saving the changes.
However, that leaves the VBA... We're talking a full purge here, so everything must go. I'll figure out how to do all of this on my own, I just don't want to waste time pursuing something that isn't possible:
Can VBA code delete itself from a workbook while running or does it have to be deleted from a macro on another workbook? And would deleting the code cause the macro to stop running, or can I have it delete everything except a nasty MsgBox after everything is done?

I'll leave the comments to debating whether or not this is a good idea (IMHO it probably isn't). As to the question itself, of course it's possible, and won't interrupt macro execution:
Public Sub Example()
Dim proj As Object
Set proj = ThisWorkbook.VBProject
Dim comp As Object
For Each comp In proj.VBComponents
With comp.CodeModule
.DeleteLines 1, .CountOfLines
If comp.Name = "ThisWorkbook" Then
.InsertLines 1, "Private Sub Workbook_Open()" & vbCrLf & _
vbTab & "MsgBox ""Where's my money, ##$%&!?""" & vbCrLf & _
"End Sub"
End If
End With
Next
ThisWorkbook.Save
End Sub
Obfuscation is an exercise for the reader.

Put a loop with due date as your payment data . Inside write code to get macro into infinity loop or to delete code.
If payment happens on time then just comment above piece of code or else just wait client come back to you on next day defined in loop.

Related

Count selected lines in MS Word

I wanted to count the lines of selected text in MS word document. I come up with code:
Sub Count_Lines()
ActiveDocument.ComputeStatistics (wdStatisticLines)
MsgBox ("The document contains " & NumLines & " Lines")
End sub
But it actually count the line of whole document.
Can anybody help, finding code which could count selected line only?
Just use Selection.Range object instead of ActiveDocument
Sub Count_Lines()
MsgBox ("The selection contains " & Selection.Range.ComputeStatistics(wdStatisticLines) & " Lines")
End Sub
Your code intends to show the value of NumLines in the message box. However, no value was assigned to that variable. In fact the variable itself was also not declared. The code below fills these two shortcomings and then works just fine. However, it will count all the lines in the document. If you just want the selected lines use the solution offered below.
Option Explicit
Sub Count_Lines()
Dim NumLines As Long
NumLines = ActiveDocument.ComputeStatistics(wdStatisticLines)
MsgBox ("The document contains " & NumLines & " Lines")
End Sub
NB. They say, Option Explicit "forces" you to declare variables which forces the reaction to resist. Compare the force with that of the traffic police who insist on your driving on the right side of the road. Using Option Explicit will not prolong your life but it will drastically reduce the amount of time you spend chasing stupid errors because you are too proud to let your computer point them out to you. Option Explicit was the tool that provided me with an immediate pointer to the source of the problem you are seeking help on here.

Excel bug message box output writes on cell

On one of my Excel projects I have a "saving check" feature that if the workbook has not been saved in the past 25 min it will prompt user to take some action (MsgBox).
This method invokes Application.OnTime to schedule next alert and is being rescheduled once is saved.
Today we saw a bug where the contents of the message box (and additional text with "Microsoft Excel" & "OK") were printed out to a worksheet, overwriting cell contents.
According to the user no macro was running in the background and the only action being taken was switching between worksheets. Those sheets have no event triggered code.
I though OnTime was safe method but that bug just freaked me out.
I have done some research trying to find documentation about this issue but couldn't. I believe it must be a low prob event that might happens once in a lifetime.
Any comments about if I should I keep this code or wipe it out?
Many thanks in advance.
' EDIT 1 - Adding code being called by the OnTime Function
Public Sub NeedToBeSaved()
' ======================================================================
' Description : Periodically checks if the workbook needs to be saved.
'
' Comments : AfterSave method takes care of scheduling new check.
' Refresh it only if user has not saved
' ======================================================================
Dim nme As Name
Dim dteLastSaved As Date
Set nme = ThisWorkbook.Names(gsRNGNAME_LASTSAVED)
dteLastSaved = Mid$(nme.value, 2)
' Debug Log
' ---------
Debug.Print "----------------------"
Debug.Print "Saving Periodic Check"
Debug.Print "----------------------"
Debug.Print "Worbook is saved:" & vbTab & ThisWorkbook.saved
Debug.Print "Last time :" & vbTab & dteLastSaved
If (ThisWorkbook.saved = False) Then
MsgBox "File has not been saved in the last " & glAPP_SAVED_FREQ & _
" minutes, please consider saving your changes. " & _
vbCrLf & "(To prevent this message open in read-only mode)"
Call SaveOnTimeCheck
Else
Debug.Print "Not rescheduled"
End If
End Sub
This is the most likely scenario to me:
Imagine someone does some copy paste actions in your workbook. He doesn't look on the screen but on his keyboard because he's not familiar with typing blind. The MsgBox pops up (he doesn't notice, still eyes on keybord). He accidentally copies the content of the MsgBox ctrl+c and pastes it into the workbook.
This adds an additional "Microsoft Excel" and lines "---" and "OK" to the message like below:
---------------------------
Microsoft Excel
---------------------------
Your MsgBox message here …
---------------------------
OK
---------------------------
You can easily reproduce this yourself by pressing ctrl+c while a MsgBox is up. And pasting it into Excel afterwards.
There are 2 possible reasons for this:
The manual copy paste scenario I described above (most likely).
Alternatively there was a macro running in the background doing copy paste actions while the MsgBox was up (I'm not 100 % sure but I think this is even not possible, but if so you should be able to reproduce the issue).

Run Code In Worksheets Class Code Module In Another Workbook

This code is in a Workbook. ( In a Worksheets Class code Module )
Sub Testie()
Dim FullPathAndName As String
Let FullPathAndName = "'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'"
Application.Run Macro:=FullPathAndName & "!FrmProTypeIn", Arg1:=42
End Sub
In another Workbook, named “NeuProAktuelleMakros.xlsm”, which is in the same Folder, I have this code, (in a Normal Code Module):
Sub FrmProTypeIn(MyArg As Long)
MsgBox prompt:="Got Here :). The answer is " & MyArg & " , I forgot the question"
End Sub
If I run the first code, it makes the second code run , ( which tells me I got there and that the answer is 42, I forgot the question )
I would prefer to have the code, FrmProTypeIn() , (which is currently in a Normal Code Module) to be in a Worksheets Code Module. The Worksheet Name is “FoodsLookUpTable”. The Worksheet Code Name is “Tabelle11”
Is this possible and can you give me the syntax?
If that is not possible, what about a simple work around? – The obvious thing I can think of is to have a Call ing code in a normal Module in Workbook “NeuProAktuelleMakros.xlsm” thus:
Sub CallFrmProTypeIn(MyArg As Long)
Application.Run Macro:=Worksheets("FoodsLookUpTable").FrmProTypeIn(MyArg)
End Sub
Then I modify the first code slightly to this:
Sub Testies2()
Dim FullPathAndName As String
Let FullPathAndName = "'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'"
Application.Run Macro:=FullPathAndName & "!CallFrmProTypeIn", Arg1:=42
End Sub
That workaround works. But maybe there is a simpler way?
The syntax would be:
Let FullPathAndName = "'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'"
Application.Run Macro:=FullPathAndName & "!Sheet1.FrmProTypeIn", Arg1:=42
# Peh
Hi Peh
I had not tried that. That and variations of it do work . Great Thanks. I had been told that this was not possible as I was told that a code cannot be run from a Worksheets code module in another Workbook.
I am wondering if this is telling me that technically I the code has become now a Property of the Worksheets Class module.
So the first three lines here are variations of your suggestion that work.
The last two are typical variation that I had been trying which do not work
Sub PehTesties()
Workbooks("NeuProAktuelleMakros.xlsm").Application.Run Macro:=Worksheets("FoodsLookUpTable").FrmProTypeIn(42)
Application.Run Macro:=Worksheets("FoodsLookUpTable").FrmProTypeIn(42)
Application.Run Macro:=Workbooks("NeuProAktuelleMakros.xlsm").Worksheets("FoodsLookUpTable").FrmProTypeIn(42)
' Application.Run Macro:=Workbooks("NeuProAktuelleMakros.xlsm").Worksheets("FoodsLookUpTable").FrmProTypeIn Arg1:=42
' Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "NeuProAktuelleMakros.xlsm'!FoodsLookUpTable!CallFrmProTypeIn", Arg1:=42
End Sub
Thanks once again
Alan
Summarising for Prosperity: ( Subject to Edits based on any correcting comments. ;) )
It seems that you can call an Excel code routine ( including those in a Worksheets Class code Module ) from another Workbook. You can pass any optional or required arguments to the called routine.
The documentation is not too clear, or does not explain all, or is wrong..
Using the same example, I can ..
_1) do a simple Call
Call Workbooks("NeuProAktuelleMakros.xlsm").Worksheets("FoodsLookUpTable").FrmProTypeIn(42)
Workbooks("NeuProAktuelleMakros.xlsm").Worksheets("FoodsLookUpTable").FrmProTypeIn 42
_2) There is an Application.Run Method.
_2a) But I suggest that this code line, although it “works” , probably does not get a chance to use it..
Macro:=Workbooks("NeuProAktuelleMakros.xlsm").Worksheets("FoodsLookUpTable").FrmProTypeIn(42)
I say this as I could just as well do this and it “works” also
Dim vTemp As IBlogPictureExtensibility
Let vTemp = Workbooks("NeuProAktuelleMakros.xlsm").Worksheets("FoodsLookUpTable").FrmProTypeIn(42)
I expect in the latter I did not get a chance to extend the ability to Extensivibly Blog a Picture as the evaluation set off by the = did an auto intensively initiation of the code as I accidently exposed it at the VB Component ( Tabelle11 ) interface, which pseudo made the Object in a pseudo late binding type stylio
This works also
If Workbooks("NeuProAktuelleMakros.xlsm").Worksheets("FoodsLookUpTable").FrmProTypeIn(42) Then MsgBox prompt:="It wasn't, but it did, so then perhaps was, was but too late - and then .... like did an auto intensively initiation of the routine as I accidently exposed it at the VB Component ( Tabelle11 ) interface, which pseudo made the Object in a pseudo late binding type stylio. It was not Late, it came too late"
Maybe we could refer to the above as a “pseudo” Run Method, way to Run, or Run way
_2b) Aplication.Run “StringReferrenceToMacroName”, MacroArgument1, MacroArgumet2, .....
I think this is using the Application.Run Method correctly; I believe this is wired to take a string reference to the string name of a macro, and also any arguments therefor. The basic syntax therefore would be
Application.Run Macro:="'NeuProAktuelleMakros.xlsm'!Tabelle11.FrmProTypeIn", Arg1:=42
It is important here not to confuse, as I did, a code bit like Tabelle11.FrmProTypeIn with the last string part in that last string, which is the macro name. This macro Name can be seen, for by example, by hitting Alt+F8 to list the literal names of macros
http://imgur.com/KL9pwFq
An interesting advantage of using the Application.Run Method is that the string reference may be extended to include the full path to the Workbook. This has no effect if the Workbook is open. If however, the Workbook is closed, then the workbook is opened by a code line of this form:
Application.Run Macro:="'H:\ALERMK2014Marz2016\NeueBlancoAb27.01.2014\AbJan2016\OutlineGrouping\RoryAppRun\NeuProAktuelleMakros.xlsm'!Tabelle11.FrmProTypeIn", Arg1:=42
_.....
A few last notes:
_A) These two codes are in fact doing the same thing:
Workbooks("NeuProAktuelleMakros.xlsm").Application.Run Macro:=Worksheets("FoodsLookUpTable").FrmProTypeIn(42)
Application.Run Macro:=Worksheets("FoodsLookUpTable").FrmProTypeIn(42)
They only work if Workbooks("NeuProAktuelleMakros.xlsm") is Active. This suggests that Application.Run with unqualified Workbook will go to the Active Workbook. I think that this is one of those occasions showing us that VBA is not really a Object Orientated Programming language. The Application can be called at various levels , but effectively goes “back up” the Hierarchy, so the use of Workbooks("NeuProAktuelleMakros.xlsm") has no effect.
Similarly , if “ProAktuellex8600x2.xlsm” is my workbook with the code in it, ( or any other open workbook for that matter ), then this will still work
Workbooks("ProAktuellex8600x2.xlsm").Application.Run Macro:=Workbooks("NeuProAktuelleMakros.xlsm").Worksheets("FoodsLookUpTable").FrmProTypeIn(42)
The important part is the
Workbooks("NeuProAktuelleMakros.xlsm").Worksheets("FoodsLookUpTable").FrmProTypeIn(42)
_ B) use of Run appears to default to Application.Run
_C ) We do not appear to have a Workbooks or Worksheets Run in such a way as we have , for example, a Worksheets Evaluate in addition to an Application Evaluate. This explains why ...Workbooks("NeuProAktuelleMakros.xlsm").Application.Run Macro:=Worksheets("FoodsLookUpTable").FrmProTypeIn(42) ... is “ignoring” the Workbooks("NeuProAktuelleMakros.xlsm")

VBA Refactoring, MsgBox everywhere

I'm very reluctant to post this as I'm not looking for anyone to write code, rather to get me moving in the right direction here.
I have inherited a huge mass of VBA. I've rewritten an awful lot of it, but I've hit a wall here.
Basically the code checks through millions of lines of an external file, and checks character by character for certain values. However, the code displays a message box MsgBox for EVERY single value.
Here is an example:
If CharArray(1) = "S" & CharArray(2) = "SO" Then
MsgBox "Hello Stack Overflow"
Else: MsgBox "Hello somewhere else"
EndIf
And it goes on like this, thousands of times. I will refactor the endless If statements myself. Is there anything I can do to save this? I was going to just comment out manually any MsgBox that isn't displaying an error, but it's still potentially a mess.
Can I write to a cell with the data, and increment to the next row easily from my own Sub or Function to just do a replace of MsgBox with something else? That is to say write Sub ReplaceMsgBoxes() have it write to a current row, whatever the message box was going to write, and go on a line?
Questions:
Would this Sub need a global counter variable (for the Row to write to)?
Is there a commonly used method by programmers to get around this kind of mess?
If I write a Sub to replace this can I call the same way, i.e.
ReplaceMsgBox "Whatever the text for the MsgBox was to begin with"
Many thanks.
One easy way is to buffer the material into a string and then do a single MsgBoxSay we want to find all the dog in A1 thru A100
Sub FindDog()
Dim dog As String, msg As String
dog = "dog"
msg = ""
For i = 1 To 100
If Cells(i, 1).Value = dog Then
msg = msg & vbCrLf & Cells(i, 1).Address(0, 0)
End If
Next i
MsgBox msg
End Sub
If there were very many items, I would use a scrollable ListBox instead.
To write to a cell:
activecell = "what ever you want to say"
to advance to the next cell (below)
activecell.offset(1,0).select

How to make Excel VBA Automation Execute for All End Users

I wrote the following code so that when an Excel spreadsheet is closed it will update its name with the current date and time:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ThisWorkbook.Name = "Name_Last Opened-" & Format(Date, "MM-DD-YYYY") & _
"_" & Format(Time, "HH.MM") & ".xls" Then
Else
ThisWorkbook.SaveAs Filename:="\\C:\... Name_Last Opened-" & _
Format(Date, "MM-DD-YYYY") & "_" & Format(Time, "HH.MM") & ".xls"
FName = Sheets("Name").Range("D1").Text
Kill FName
End If
End Sub
Private Sub Workbook_Open()
Range("A1").Select
ActiveCell.FormulaR1C1 = ThisWorkbook.Name
End Sub
Additionally, the code is located within VBAProject(Name of file), under MS Excel Object - ThisWorkbook.
This code works perfectly for me or the workstation that it was created on; however, it does not execute for anyone who opens it on their worstation. Would anyone know how to get the code to execute whenever the spreadsheet is opened and closed from any computer, not just mine?
Thank you,
DFM
It's possible that Excel's security settings aren't allowing other people's computers to run the script that could be interpreted as risky malware. Perhaps you changed your security settings so long ago that you forgot about it. See if you can modify another user's security settings to see if that will make the macro execute on the workbook close.
"Would anyone know how to get the code to execute whenever the spreadsheet is opened and closed from any computer, not just mine?"
I don't think it can be done with 100% certainty unless you can ensure that every possible user will have macro security set such that your macro can execute.
Assuming you can get past that one, you should perhaps check that the users all have the worksheet in the same hard-coded path on C:\ that you seem to be using. What happens if they open the workbook from a different location?
Also:
FName = Sheets("Name").Range("D1").Text
is getting a value from one place and
Range("A1").Select
ActiveCell.FormulaR1C1 = ThisWorkbook.Name
is putting it in another.
I think I'd try something like the following (which assumes from your code that you actually only want to change the file name if it has not changed since the minute of the current time changed):
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim dateTime As String
Dim oldPath As String
Dim newPath As String
dateTime = Format(Now, "MM-DD-YYYY_HH.MM") ' Format the while thing in one string - once
With ThisWorkbook
oldPath = .FullName ' what is it called now, and where did it come from?
newPath = .Path & "\" & "Name_Last Opened-" & dateTime & ".xls" ' what should it be called now?
If oldPath <> newPath Then ' only do something if not saved in last minute - is that what you really want?
.SaveAs Filename:=newPath
Kill oldPath
End If
End With
End Sub
Date() function needs administrator access to run.. so if your user is a non admin, then it will fail. Instead use now(). Most of the times this is some thing which we usually forget as we(people developing the tool) have admin access over our PC's
Fundamentally, you cannot ensure that all users will a) have a macro security setting of low or medium, and b) if set to medium, enable them when the file is opened.
Creating your own certificate would seem like the obvious answer, but in practice I find that the resultant messages and warnings are even more confusing/frightening for some end users, leading to much the same situation as with macro security. Third-party certificates avoid this, but are $$$ and almost surely overkill for an Excel workbook in a corporate environment.
What I've done where I need users to have VBA enabled is to set all sheets to xlveryhidden on save, except a custom locked sheet that only has a note saying macros must be enabled and a brief guide on how to do this. This sheet is hidden and the others restored by the workbook's workbook_open procedure, something that of course will not fire if VBA is disabled.