Dim h, Sourcefile, Destinationfile As String h = MsgBox("确定要复制吗?", vbYesNo, "询问") If h = vbYes Then Sourcefile = "\\system\cove.txt" '原文件位置 Destinationfile = "e:\ho\cove.txt" '目标文件位置 FileCopy Sourcefile, Destinationfile End If End Sub
说得好晕我这个是COPY文件夹的 三个Command 二个text 'FORM1:Dim fso As New FileSystemObject, drv As Drive Dim Hook As Long '路径选取框(选择文件夹) Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Public Enum DirFlags BIF_BROWSEFORCOMPUTER = &H1000& BIF_BROWSEFORPRINTER = &H2000& BIF_BROWSEINCLUDEFILES = &H4000& BIF_DONTGOBELOWDOMAIN = &H2& BIF_EDITBOX = &H10& BIF_RETURNFSANCESTORS = &H8& BIF_RETURNONLYFSDIRS = &H1& BIF_STATUSTEXT = &H4& BIF_VALIDATE = &H20& End Enum Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal pszPath As String) As LongPublic Function ShowDirBox(ByVal hWnd As Long, Optional ByVal Title As String, Optional DirName As String, Optional ByVal flags As DirFlags) As String '选择框文件夹路径函数 Dim FileDis As BROWSEINFO, FilePath As String, IntLen As Integer With FileDis .hOwner = hWnd .lpszTitle = Title .ulFlags = flags .pszDisplayName = String(260, 0) End With FilePath = String(260, 0) SHGetPathFromIDList SHBrowseForFolder(FileDis), FilePath IntLen = InStr(FilePath, vbNullChar) If IntLen = 0 Then Exit Function ShowDirBox = Left$(FilePath, IntLen - 1) IntLen = InStr(FileDis.pszDisplayName, vbNullChar) If IntLen = 0 Then Exit Function DirName = Left$(FileDis.pszDisplayName, IntLen - 1) 'MsgBox ShowDirBox(Me.hWnd, , , BIF_EDITBOX) '此句可得对话框 End FunctionPrivate Sub command1_click() 'COPY 文件 '“引用”对话框选择“Microsoft Scripting Runtime”项 Dim AppCopyName As String, PathName As String Dim fol As Folder Form1.Visible = False If Text1 <> "" And Text2 <> "" Then AppCopyName = Text1.Text PathName = Text2.Text Set fol = fso.GetFolder(AppCopyName) '"要复制的文件夹" fol.Copy PathName, True '"目标文件夹" Frame1.Caption = "F10隐藏或显示窗体 状态: COPY完毕!" End If If Frame1.Caption = "F10隐藏或显示窗体 状态: COPY完毕!" Then Form1.Visible = True End If End SubPrivate Sub Command2_Click() Text1.Text = ShowDirBox(Me.hWnd, , , BIF_EDITBOX) End SubPrivate Sub Command3_Click() Text2.Text = ShowDirBox(Me.hWnd, , , BIF_EDITBOX) End SubPrivate Sub Form_Load() Frame1.Caption = "F10隐藏或显示窗体 状态: 等待COPY……" Hook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf HookFunc, App.hInstance, 0) '设置热键 End SubPrivate Sub Form_Unload(Cancel As Integer) If Hook <> 0 Then UnhookWindowsHookEx Hook End Sub '模块 '添加一模块:Module1.basPublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Public Const HC_ACTION = 0 Public Const WM_KEYDOWN = &H100 Public Const WM_KEYUP = &H101 Public Const WM_SYSKEYDOWN = &H104 Public Const WM_SYSKEYUP = &H105 Public Const VK_TAB = &H9 Public Const VK_CONTROL = &H11 Public Const VK_ESCAPE = &H1BPublic Const WH_KEYBOARD_LL = 13 Public Const LLKHF_ALTDOWN = &H20Public Type KBDLLHOOKSTRUCT vkCode As Long scanCode As Long flags As Long time As Long dwExtraInfo As Long End TypeDim p As KBDLLHOOKSTRUCTPublic Function HookFunc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim f As Boolean
If (nCode = HC_ACTION) Then If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Then CopyMemory p, ByVal lParam, Len(p)
If p.vkCode = 121 Then Form1.Visible = Not Form1.Visible '如果按下"F10"键则显示或隐藏窗口 End If
app.path & "\1\1.txt" ???
怎么不写盘符,就可以把他复制到其他盘例如 shell "\1\1.txt" 这样
莫非是像DOS命令一样?只知道.\代表当前目录,..\代表上一级目录,\在DOS是代表根目录,不过要先ChDrive "X:\"转到目标盘的根目录才可以用Shell "\1.exe"…………
不知道我的理解对了没?
Dim h, Sourcefile, Destinationfile As String
h = MsgBox("确定要复制吗?", vbYesNo, "询问")
If h = vbYes Then
Sourcefile = "\\system\cove.txt" '原文件位置
Destinationfile = "e:\ho\cove.txt" '目标文件位置
FileCopy Sourcefile, Destinationfile
End If
End Sub
VB程序在根目录"\1\1.txt "这个意思是 当前盘(VB程序所在盘)--根目录下的--1目录下的--1.txt可以如下这样写:Private Sub Form_Load()
FileCopy "\1\1.txt", "e:\1.txt"
End Sub
VB程序在根目录"\1\1.txt "这个意思是 当前盘(VB程序所在盘)--根目录下的--1目录下的--1.txt可以如下这样写:Private Sub Form_Load()
FileCopy "\1\1.txt", "e:\1.txt"
End Sub
'FORM1:Dim fso As New FileSystemObject, drv As Drive
Dim Hook As Long
'路径选取框(选择文件夹)
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Public Enum DirFlags
BIF_BROWSEFORCOMPUTER = &H1000&
BIF_BROWSEFORPRINTER = &H2000&
BIF_BROWSEINCLUDEFILES = &H4000&
BIF_DONTGOBELOWDOMAIN = &H2&
BIF_EDITBOX = &H10&
BIF_RETURNFSANCESTORS = &H8&
BIF_RETURNONLYFSDIRS = &H1&
BIF_STATUSTEXT = &H4&
BIF_VALIDATE = &H20&
End Enum
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal pszPath As String) As LongPublic Function ShowDirBox(ByVal hWnd As Long, Optional ByVal Title As String, Optional DirName As String, Optional ByVal flags As DirFlags) As String '选择框文件夹路径函数
Dim FileDis As BROWSEINFO, FilePath As String, IntLen As Integer
With FileDis
.hOwner = hWnd
.lpszTitle = Title
.ulFlags = flags
.pszDisplayName = String(260, 0)
End With
FilePath = String(260, 0)
SHGetPathFromIDList SHBrowseForFolder(FileDis), FilePath
IntLen = InStr(FilePath, vbNullChar)
If IntLen = 0 Then Exit Function
ShowDirBox = Left$(FilePath, IntLen - 1)
IntLen = InStr(FileDis.pszDisplayName, vbNullChar)
If IntLen = 0 Then Exit Function
DirName = Left$(FileDis.pszDisplayName, IntLen - 1)
'MsgBox ShowDirBox(Me.hWnd, , , BIF_EDITBOX) '此句可得对话框
End FunctionPrivate Sub command1_click() 'COPY 文件
'“引用”对话框选择“Microsoft Scripting Runtime”项
Dim AppCopyName As String, PathName As String
Dim fol As Folder
Form1.Visible = False
If Text1 <> "" And Text2 <> "" Then
AppCopyName = Text1.Text
PathName = Text2.Text
Set fol = fso.GetFolder(AppCopyName) '"要复制的文件夹"
fol.Copy PathName, True '"目标文件夹"
Frame1.Caption = "F10隐藏或显示窗体 状态: COPY完毕!"
End If
If Frame1.Caption = "F10隐藏或显示窗体 状态: COPY完毕!" Then
Form1.Visible = True
End If
End SubPrivate Sub Command2_Click()
Text1.Text = ShowDirBox(Me.hWnd, , , BIF_EDITBOX)
End SubPrivate Sub Command3_Click()
Text2.Text = ShowDirBox(Me.hWnd, , , BIF_EDITBOX)
End SubPrivate Sub Form_Load()
Frame1.Caption = "F10隐藏或显示窗体 状态: 等待COPY……"
Hook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf HookFunc, App.hInstance, 0) '设置热键
End SubPrivate Sub Form_Unload(Cancel As Integer)
If Hook <> 0 Then UnhookWindowsHookEx Hook
End Sub
'模块
'添加一模块:Module1.basPublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const HC_ACTION = 0
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const VK_TAB = &H9
Public Const VK_CONTROL = &H11
Public Const VK_ESCAPE = &H1BPublic Const WH_KEYBOARD_LL = 13
Public Const LLKHF_ALTDOWN = &H20Public Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End TypeDim p As KBDLLHOOKSTRUCTPublic Function HookFunc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim f As Boolean
If (nCode = HC_ACTION) Then
If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Then
CopyMemory p, ByVal lParam, Len(p)
If p.vkCode = 121 Then
Form1.Visible = Not Form1.Visible '如果按下"F10"键则显示或隐藏窗口
End If
End If
End If
HookFunc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function