本实例可快速重复创建多个,或者同时创建多个虚拟磁盘驱动器,并且可以一次删除多个虚拟磁盘驱动器。 标准模块: Option Explicit Private Declare Function DefineDosDevice Lib "kernel32" Alias "DefineDosDeviceA" (ByVal dwFlags As Long, ByVal lpDeviceName As String, Optional ByVal lpTargetPath As String = vbNullString) As Long Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Const DRIVE_REMOVABLE As Long = 2 Private Const DRIVE_FIXED As Long = 3 Private Const DRIVE_REMOTE As Long = 4 Private Const DRIVE_CDROM As Long = 5 Private Const DRIVE_RAMDISK As Long = 6 Public Const DDD_RAW_TARGET_PATH As Long = &H0 '创建本地驱动器 Public Const DDD_REMOVE_DEFINITION As Long = &H2 '删除指定的虚拟驱动器 Public VirtualDriverLetter As String * 1 '虚拟驱动器字母 Public VirtualDriverSymbol As String '创建的虚拟驱动器连接 '自动创建/删除虚拟驱动器 Public Function CreateOrDelVirtualDrive(ByVal DeviceID As Long, Optional ByVal sExistPath As String) As Boolean Dim Rtn As Long, i As Long Dim MyComputerDrive(23) As String * 1, Ret As Long On Error GoTo ErrHandle For i = 0 To 22 MyComputerDrive(i) = Chr(i + 100) Next If DeviceID = DDD_RAW_TARGET_PATH Then For i = 22 To 0 Step -1 Rtn = GetDriveType(MyComputerDrive(i)) Select Case Rtn Case DRIVE_REMOVABLE, DRIVE_FIXED, DRIVE_REMOTE, DRIVE_CDROM, DRIVE_RAMDISK '不能在已存在的可移动磁盘、固定磁盘、远程驱动器、光驱、电子盘上创建虚拟驱动器 Case Else VirtualDriverLetter = MyComputerDrive(i) If Dir(VirtualDriverLetter & ":/", vbDirectory) = "" Then If Dir(sExistPath, vbDirectory) <> "" Then '将已存在的路径sExistPath虚拟为磁盘VirtualDriverLetter Ret = DefineDosDevice(DeviceID, VirtualDriverLetter & ":", sExistPath) If CBool(Ret) Then VirtualDriverSymbol = VirtualDriverSymbol & VirtualDriverLetter Debug.Print VirtualDriverSymbol CreateOrDelVirtualDrive = True: Exit Function '创建成功 Else CreateOrDelVirtualDrive = False: Exit Function '创建失败 End If Else CreateOrDelVirtualDrive = False: Exit Function '创建失败 End If End If End Select Next Else If Len(VirtualDriverSymbol) = 0 Then MsgBox ("不存在已创建的虚拟驱动器!") Exit Function End If VirtualDriverSymbol = Trim(VirtualDriverSymbol) For i = 1 To Len(VirtualDriverSymbol) VirtualDriverLetter = Mid$(VirtualDriverSymbol, i, 1) If Dir(VirtualDriverLetter & ":/", vbDirectory) <> "" Then Rtn = DefineDosDevice(DeviceID, VirtualDriverLetter & ":") '删除已创建的虚拟驱动器 If CBool(Rtn) Then CreateOrDelVirtualDrive = True '删除成功 Else CreateOrDelVirtualDrive = False '删除失败 End If End If Next VirtualDriverSymbol = "" ErrHandle: Exit Function End If CreateOrDelVirtualDrive = False '失败 End Function 窗体模块: Option Explicit '创建虚拟驱动器(可重复创建多个或者同时创建多个) Private Sub Command1_Click() Call CreateOrDelVirtualDrive(DDD_RAW_TARGET_PATH, "C:/Documents and Settings/All Users") End Sub '删除虚拟驱动器(可一次删除多个) Private Sub Command2_Click() Call CreateOrDelVirtualDrive(DDD_REMOVE_DEFINITION) End Sub Private Sub Form_Load() VirtualDriverSymbol = "" Command1.Caption = "创建虚拟驱动器" Command2.Caption = "删除虚拟驱动器" End Sub