[Excerpt] Some Applications of VBA (operations such as USB flash drive serial number as password and regular file deletion)

Note: Only part of the original text is excerpted.

Original article address:

Http://club.excelhome.net/forum.php? Mod = viewthread & tid = 449527.

 

 

I don't do the technology, but I often use EXCEL to process data. Today I find something interesting and record it. I will use this method to keep my information confidential. Just tell others.

 

 

1-19 use the U disk serial number as the work thin to open the password
Private Sub Workbook_Open ()
Call udisc lock code
End Sub

Sub udisc lock code ()
Dim fs, d, s $
On Error Resume Next
For I = 3 To 26' 26 letters
Set fs = CreateObject ("scripting. filesystemobjEct ")
Set d = fs. getdrive (Chr (64 + I )&":")
S = d. SERIALNUMBER 'Get the serial number of the drive
Select Case s
Case "134374432" 'U disk serial number
MsgBox "opened successfully"
Exit Sub
End Select
Set fs = Nothing
Set d = Nothing
Next
ThisWorkbook. Close False
End Sub
Note 1:

NOTE 2:
Workbook. Close method: Close the object.
Syntax: expression. Close (SaveChanges, Filename, RouteWorkbook)
Expression is a variable that represents a Workbook object.
Parameters
Name required/optional data type description
SaveChanges (optional) Variant. this parameter is ignored if the workbook is not changed. This parameter is ignored if the workbook is changed but displayed in other open windows. If there are changes in the workbook and the workbook is not displayed in any other open window, this parameter specifies whether the changes should be saved. If it is set to True, the changes made to the workbook are saved. If the workbook is not named, FileName is used. If Filename is omitted, the user is required to provide the file name.

Filename is optional. Variant saves the changes made by using this file name.
RouteWorkbook (optional) Variant this parameter is ignored if the workbook does not need to be transferred to the next recipient (no transfer list or transferred. Otherwise, Microsoft Excel transfers the workbook based on the value of this parameter. If it is set to True, the workbook is sent to the next recipient. If it is set to False, the workbook is not sent. If the workbook is ignored, you are required to confirm whether to send the workbook.

Note: Close the workbook from Visual Basic and do not run any Auto_Close macro In the workbook. You can run the RunAutoMacros method to automatically disable macros.
Example: In this example, disable Book1.xls and discard all changes to this workbook.
Visual Basic for Applications
Workbooks ("BOOK1.XLS"). Close SaveChanges: = False
Obtain all disk Sequences
Obtain the serial number of all disks ()
Dim fs, d, aa As String, B As String, c As String
Set fs = CreateObject ("Scripting. FileSystemObject ")
On Error Resume Next
For I = 1 To 26
Bb:
Aa = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
B = Mid (aa, I, 1)
Set d = fs. getdrive (fs. GetDriveName (fs. GetAbsolutePathName (B &":")))
If Err. Number = 68 Then
S = B & ": the disk is not ready"
Err. Clear
GoTo aa
End If
Select Case d. DriveType
Case 0: t = "Unknown"
Case 1: t = "Removable"
Case 2: t = "Fixed"
Case 3: t = "Network"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
S = "Disk:" & d. DriveLetter & "type:" & t & "serial number:" & d. SERIALNUMBER
Aa:
C = c & s & Chr (10)

Next I
MsgBox c, 64, "andysky prompts you"
End Sub

Improved udisc lock Protection
Sub udisc lock ()
Dim fs, s $
On Error Resume Next
Set fs = CreateObject ("scripting. filesystemobjEct ")
For Each DRI In fs. DRIVES
S = DRI. SERIALNUMBER
If s = "134374432" then' U disk serial number
MsgBox "opened successfully"
Set fs = Nothing
Exit Sub
End If
Next
Set fs = Nothing
MsgBox "Opening failed"
ThisWorkbook. Close False
End Sub

1.10 open a specified folder with a program
Sub open the specified folder ()
Dim Ret
Ret = Shell ("assumer.exe" & ThisWorkbook. Path & "\ A \", vbNormalFocus)
End Sub
Shell function: Execute an executable file and return a Variant (Double). If it succeeds, it indicates the task ID of the program. If it fails, it returns 0.
Syntax: Shell (pathname [, windowstyle])
The syntax of the shell function contains the following naming parameters:
Partial description
Required pathname parameters. Variant (string), the name of the program to be executed, and any required parameters or command line variables, may also include directories or folders, and drives. In the Macintosh, you can use the macid function to specify the signature rather than the name of an application. The following example uses the Microsoft Word Signature: Shell macid ("mswd ")

Optional. Variant (integer) indicates the window style when the program is running. If windowstyle is omitted, the program runs in a minimized window with focus. In MacIntosh (system 7.0 or higher), windowstyle only determines whether the focus is obtained when the application is running.

Windowstyle naming parameters have the following values:
Constant Value description
The vbhide 0 window is hidden, and the focus is moved to the implicit window. Constant vbhide is unavailable on the Macintosh platform.
The vbnormalfocus 1 window has a focus and is restored to its original size and position.
The vbminimizedfocus 2 window is displayed with a focal point icon.
The vbmaximizedfocus 3 window is a maximized window with focus.
The vbnormalnofocus 4 window is restored to the recently used size and position, while the current active window is still active.
The vbminimizednofocus 6 window is displayed with an icon. The window of the current activity is still active.
Description
If the shell function successfully executes the file to be executed, it returns the task ID of the program. A task id is a unique value used to indicate a running program. If the shell function cannot open the named program, an error occurs.
In Macintosh, vbnormalfocus, vbminimizedfocus, and vbmaximizedfocus both place applications at the front end, while vbhide, vbnofocus, and vbminimizefocus both place applications at the back end.
Note that by default, Shell functions execute other programs asynchronously. That is to say, the program started with Shell may have been executed after the shell function before the execution process is completed.

1.14 timed "suicide" Excel files
Private sub workbook_open ()
If now ()> = #9/15/2006 # then' time format must be followed by "#"
Activeworkbook. changefileaccess xlreadonly
Kill activeworkbook. fullname
Application. Quit
End if
End sub
Workbook. changefileaccess method: Change the ACL of a workbook. In this method, the updated version of the workbook needs to be loaded from the disk.
Syntax: expression. changefileaccess (mode, writepassword, Policy)
Expression is a variable that represents a workbook object.
Parameters
Name required/optional data type description
Mode: XlFileAccess is required to specify the new access Mode.
WritePassword (optional) Variant: Specifies the write protection password if the write protection Mode is xlReadWrite. If the file does not have a password or the Mode is xlReadOnly, ignore this parameter.

Notify (optional) Variant if this value is True (or this parameter is omitted), the user is notified when the file cannot be accessed immediately.
Note: If you open a file in read-only mode, you cannot exclusively access the file. If you change the file from read-only to read/write, Microsoft Excel must load a new copy of the file to ensure that the file has not been changed since it was opened in read-only mode.
Example: In this example, the workbook is read-only.
Visual Basic for Applications
ActiveWorkbook. ChangeFileAccess Mode: = xlReadOnly

1.15 limit the number of Excel files used
Private Sub Workbook_Open ()
AAA = GetSetting (appname: = "MyApp", section: = "Startup", key: = "Times", Default: = 1)
MsgBox "the number of times you can use is" & (20-AAA) & ". Please contact the author as soon as possible! "
If AAA = 20 Then
DeleteSetting "MyApp", "Startup"
MsgBox "system will be deleted. Thank you for your trial! Goodbye"
ActiveWorkbook. ChangeFileAccess xlReadOnly
Kill ActiveWorkbook. FullName
ThisWorkbook. Close False
End If
AAA = AAA + 1
SaveSetting "MyApp", "Startup", "Times", AAA
End Sub
See instance 3 _ 54

1.18 Excel files that can only be used on your computer
Private Sub Workbook_Open ()
Application. ScreenUpdating = False
On Error GoTo 100
Workbooks. Open ThisWorkbook. Path & "/verify. XLS"
ActiveWorkbook. Close False
Exit Sub
100:
MsgBox "you cannot use this file. Please contact the file Author"
ThisWorkbook. Close False
Application. ScreenUpdating = True
End Sub

Disabled macros to automatically disable the workbook
Function MY ()

End Function

= ERROR (FALSE)
= RUN ("MY ")
= IF (ISERROR ($ A $3 ))
= GOTO ($ A $11)
= END. IF ()
= ERROR (TRUE)
= RETURN ()

= ALERT ("Sorry! This file will be closed automatically because macros are disabled! ", 3)
= FILE. CLOSE (FALSE)
= RETURN ()