当前位置:编程学习 > VB >>

Vb复制文件

我找了很久都没有正确答案,望大侠们告知啊

我想用VB复制一个文件到E盘.

例如:复制 "\1\1.txt"  到"E:\"源目录没有盘符.VB程序需要将子目录文件复制到E盘.VB程序在根目录下.

不知我说得清楚不` --------------------编程问答-------------------- 没看明白
app.path & "\1\1.txt" ??? --------------------编程问答-------------------- 我说的意思是..

VB程序和要被复制的文件在同一目录..
怎么不写盘符,就可以把他复制到其他盘

例如 shell "\1\1.txt" 这样 --------------------编程问答-------------------- 不写盘符…………*_*
莫非是像DOS命令一样?只知道.\代表当前目录,..\代表上一级目录,\在DOS是代表根目录,不过要先ChDrive "X:\"转到目标盘的根目录才可以用Shell "\1.exe"…………
不知道我的理解对了没? --------------------编程问答-------------------- 不理解.... --------------------编程问答-------------------- 例如这个...



Private Sub Command1_Click()
  
          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 --------------------编程问答-------------------- Sourcefile = app.path & "\system\cove.txt"  ?????? --------------------编程问答--------------------  app.path   即当前目录 --------------------编程问答-------------------- 楼主的意思应该是App.Path & "\1\1.txt " --------------------编程问答-------------------- 楼主的意思应该是App.Path & "\1\1.txt " --------------------编程问答-------------------- 楼主的意思应该是App.Path & "\1\1.txt " --------------------编程问答-------------------- 复制   "\1\1.txt "     到 "E:\ "源目录没有盘符.VB程序需要将子目录文件复制到E盘.
VB程序在根目录

"\1\1.txt "这个意思是 当前盘(VB程序所在盘)--根目录下的--1目录下的--1.txt

可以如下这样写:

Private Sub Form_Load()
    FileCopy "\1\1.txt", "e:\1.txt"
    
End Sub


--------------------编程问答-------------------- 复制   "\1\1.txt "     到 "E:\ "源目录没有盘符.VB程序需要将子目录文件复制到E盘.
VB程序在根目录

"\1\1.txt "这个意思是 当前盘(VB程序所在盘)--根目录下的--1目录下的--1.txt

可以如下这样写:

Private Sub Form_Load()
    FileCopy "\1\1.txt", "e:\1.txt"
    
End Sub


--------------------编程问答--------------------   FileCopy   --------------------编程问答-------------------- 说得好晕

我这个是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 Long

Public 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 Function

Private 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 Sub

Private Sub Command2_Click()
Text1.Text = ShowDirBox(Me.hWnd, , , BIF_EDITBOX)
End Sub

Private Sub Command3_Click()
Text2.Text = ShowDirBox(Me.hWnd, , , BIF_EDITBOX)
End Sub

Private Sub Form_Load()
Frame1.Caption = "F10隐藏或显示窗体 状态: 等待COPY……"
 Hook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf HookFunc, App.hInstance, 0)  '设置热键
End Sub

Private Sub Form_Unload(Cancel As Integer)
If Hook <> 0 Then UnhookWindowsHookEx Hook
End Sub


'模块
'添加一模块:Module1.bas

Public 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 = &H1B

Public Const WH_KEYBOARD_LL = 13
Public Const LLKHF_ALTDOWN = &H20

Public Type KBDLLHOOKSTRUCT
 vkCode As Long
 scanCode As Long
 flags As Long
 time As Long
 dwExtraInfo As Long
End Type

Dim p As KBDLLHOOKSTRUCT

Public 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
补充:VB ,  基础类
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,