[摘抄]VBA的一些应用（U盘序列号作密码，定时删除文件等操作）

注：本文只摘抄原文的一部分

原文地址： http://club.excelhome.net/forum.php?mod=viewthread&tid=449527

 

 

不做技术了，但是经常用EXCEL处理数据，今天找到点有意思的东西，记录之，以后就用这方法来保密自己的信息，唬唬其他人吧。

 

 

1-19用U盘系列号做工作薄打开密码
Private Sub Workbook_Open()
Call U盘锁代码
End Sub

Sub U盘锁代码()
Dim fs, d, s$
On Error Resume Next
For i = 3 To 26 ‘26个字母
Set fs = CreateObject("scripting.filesystemobjEct")
Set d = fs.getdrive(Chr(64 + i) & ":")
s = d.SERIALNUMBER ‘取得驱动器的系列号
Select Case s
Case "134374432" 'U盘系列号
MsgBox "成功打开"
Exit Sub
End Select
Set fs = Nothing
Set d = Nothing
Next
ThisWorkbook.Close False
End Sub
注释1：

注释2：
Workbook.Close 方法 ：关闭对象。
语法：表达式.Close(SaveChanges, Filename, RouteWorkbook)
表达式   一个代表 Workbook 对象的变量。
参数
名称 必选/可选 数据类型 描述
SaveChanges 可选 Variant 如果工作簿中没有改动，则忽略此参数。如果工作簿中有改动但工作簿显示在其他打开的窗口中，则忽略此参数。如果工作簿中有改动且工作簿未显示在任何其他打开的窗口中，则由此参数指定是否应保存更改。如果设为 True，则保存对工作簿所做的更改。如果工作簿尚未命名，则使用 FileName。如果省略 Filename，则要求用户提供文件名。
Filename 可选 Variant 以此文件名保存所做的更改。
RouteWorkbook 可选 Variant 如果工作簿不需要传送给下一个收件人（没有传送名单或已经传送），则忽略此参数。否则，Microsoft Excel 根据此参数的值传送工作簿。如果设为 True，则将工作簿传送给下一个收件人。如果设为 False，则不发送工作簿。如果忽略，则要求用户确认是否发送工作簿。
说明：从 Visual Basic 关闭工作簿并不运行该工作簿中的任何 Auto_Close 宏。使用 RunAutoMacros 方法可运行自动关闭宏。
示例：此示例关闭 Book1.xls，并放弃所有对此工作簿的更改。
Visual Basic for Applications
Workbooks("BOOK1.XLS").Close SaveChanges:=False
获取所有磁盘序列
Sub 获取所有磁盘序列号()
    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 & ":盘未准备好"
            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 = "磁盘: " & d.DriveLetter & "  类型:" & t & "   序列号: " & d.SERIALNUMBER
aa:
        c = c & s & Chr(10)

    Next i
    MsgBox c, 64, "andysky提示你"
End Sub

改进型U盘锁保护
Sub U盘锁()
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盘系列号
MsgBox "打开成功"
Set fs = Nothing
Exit Sub
End If
Next
Set fs = Nothing
MsgBox "打开失败"
ThisWorkbook.Close False
End Sub

1.10用程序打开指定文件夹
Sub 打开指定文件夹()
Dim Ret
Ret = Shell(＂explorer.exe＂ & ThisWorkbook.Path & "\A\", vbNormalFocus)
End Sub
Shell 函数：执行一个可执行文件，返回一个 Variant (Double)，如果成功的话，代表这个程序的任务 ID，若不成功，则会返回 0。
语法：Shell(pathname[,windowstyle])
Shell 函数的语法含有下面这些命名参数：
部分 描述
pathname 必要参数。Variant (String)，要执行的程序名，以及任何必需的参数或命令行变量，可能还包括目录或文件夹，以及驱动器。在Macintosh中，可以使用MacID函数来指定一个应用程序的署名而不是名称。下面的例子使用了Microsoft Word的署名: Shell MacID("MSWD")
Windowstyle 可选参数。Variant (Integer)，表示在程序运行时窗口的样式。如果 windowstyle 省略，则程序是以具有焦点的最小化窗口来执行的。在Macintosh（系统7.0或更高）中，windowstyle仅决定当应用程序运行时是否获得焦点。
windowstyle 命名参数有以下这些值：
常量 值 描述
vbHide 0 窗口被隐藏，且焦点会移到隐式窗口。常数vbHide在Macintosh平台不可用。
VbNormalFocus 1 窗口具有焦点，且会还原到它原来的大小和位置。
VbMinimizedFocus 2 窗口会以一个具有焦点的图标来显示。
VbMaximizedFocus 3 窗口是一个具有焦点的最大化窗口。
VbNormalNoFocus 4 窗口会被还原到最近使用的大小和位置，而当前活动的窗口仍然保持活动。
VbMinimizedNoFocus 6 窗口会以一个图标来显示。而当前活动的的窗口仍然保持活动。
说明
如果 Shell 函数成功地执行了所要执行的文件，则它会返回程序的任务 ID。任务 ID 是一个唯一的数值，用来指明正在运行的程序。如果 Shell 函数不能打开命名的程序，则会产生错误。
在Macintosh中，vbNormalFocus、vbMinimizedFocus和vbMaximizedFocus都将应用程序置于前台；vbHide、vbNoFocus、vbMinimizeFocus都将应用程序置于后台。
注意 缺省情况下，Shell 函数是以异步方式来执行其它程序的。也就是说，用 Shell 启动的程序可能还没有完成执行过程，就已经执行到 Shell 函数之后的语句。

1.14定时“自杀”的Excel文件
Private Sub Workbook_Open()
If Now() >= #9/15/2006# Then ‘时间格式必须在前后加“#”号
ActiveWorkbook.ChangeFileAccess xlReadOnly
  Kill ActiveWorkbook.FullName
  Application.Quit
End If
End Sub
Workbook.ChangeFileAccess 方法 ：更改工作簿的访问权限。本方法需要从磁盘加载工作簿的更新版本。
语法：表达式.ChangeFileAccess(Mode, WritePassword, Notify)
表达式   一个代表 Workbook 对象的变量。
参数
名称 必选/可选 数据类型 描述
Mode 必选 XlFileAccess 指定新的访问模式。
WritePassword 可选 Variant 如果文件设置了写保护并且 Mode 为 xlReadWrite，则指定写保护密码。如果文件没有密码或 Mode 为 xlReadOnly，则忽略此参数。
Notify 可选 Variant 如果该值为 True（或省略该参数），则当无法立即访问文件时通知用户。
说明：如果以只读模式打开文件，则不可独占访问此文件。如果将此文件从只读更改为可读写，Microsoft Excel 必须载入该文件的新副本以确认在以只读模式打开该文件后没有进行过更改。
示例：本示例将活动工作簿设为只读。
Visual Basic for Applications
ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly

1.15限制Excel文件使用的次数
Private Sub Workbook_Open()
AAA = GetSetting(appname:="MyApp", section:="Startup", key:="使用次数", Default:=1)
MsgBox "你还可以使用的次数为" & (20 - AAA) & "次,请尽快和作者联系!"
If AAA = 20 Then
   DeleteSetting "MyApp", "Startup"
   MsgBox "系统将被删除,感谢您的试用!再见"
   ActiveWorkbook.ChangeFileAccess xlReadOnly
   Kill ActiveWorkbook.FullName
   ThisWorkbook.Close False
End If
   AAA = AAA + 1
SaveSetting "MyApp", "Startup", "使用次数", AAA
End Sub
参见实例三_54

1.18只能自已电脑上使用的Excel文件
Private Sub Workbook_Open()
Application.ScreenUpdating = False
On Error GoTo 100
Workbooks.Open ThisWorkbook.Path & "/验证.XLS"
ActiveWorkbook.Close False
Exit Sub
100:
MsgBox "你无法使用该文件,请与文件作者联系"
ThisWorkbook.Close False
Application.ScreenUpdating = True
End Sub

禁用了宏自动关闭工作薄
Function MY()

End Function

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


=ALERT("对不起!由于禁用了宏,本文件将自动关闭!",3)
=FILE.CLOSE(FALSE)
=RETURN()