Question

VB中如何复制指定文件到指定文件夹，并以当前日期存放

VB中如何复制指定文件到指定文件夹，并以当前日期存放，过段时间然后恢复这个文件，直接覆盖当前的文件就行combo1.text 里面的内容就是文件名，然后在根目录里面复制这个文件到个目录的Back文件夹里面，按当前日期建立文件夹，吧这个文件存放进去。过段时间再恢复这个文件，覆盖当前同名的文件 在线等，最好有源文件，在线等

Answer 1

VB，将文件复制到指定目录下的同名文件夹中 (2008-09-19 09:43:17)转载标签： it分类： GIS二次开发界面如下： '——————————————————————————
'名称：FindFolderInAppointFolder
'作者：罗简单
'日期：2008-9-19
'功能：查找指定文件夹下的所有文件夹
'——————————————————————————
Public Sub FindFolderInAppointFolder1(ByVal myPath As String)
'函数dir返回一个满足指定类型或指定文件属性的文件名，目录名或卷标名。dir函数的语法结构为:
'Member Function Dir[(Pathname[,attributes])] As String
Dim myFolderName As String
'包括隐藏和系统的
myFolderName = Dir(myPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem)

'循环文件夹
Do While myFolderName <> ""
If myFolderName <> "." And myFolderName <> ".." Then '忽略当前目录和子目录
'确保得到的是文件夹
If (GetAttr(myPath & myFolderName) And vbDirectory) = vbDirectory Then
'在立即窗口中打印文件夹的名字
Debug.Print myFolderName
End If
End If

myFolderName = Dir '得到下一个文件名
LoopEnd SubSub test_Findfolder()
Dim myPath As String
myPath = "C:\222"

FindFolderInAppointFolder1 myPath
End Sub'——————————————————————————
'名称：FindFolderInAppointFolder
'作者：罗简单
'日期：2008-9-19
'功能：查找指定文件夹下的指定文件夹
'——————————————————————————
Public Function FindFolderInAppointFolder(ByVal myPath As String, ByVal myAppointFolderName As String) As String
'函数dir返回一个满足指定类型或指定文件属性的文件名，目录名或卷标名。dir函数的语法结构为:
'Member Function Dir[(Pathname[,attributes])] As String
Dim myFolderName As String
'包括隐藏和系统的
myFolderName = Dir(myPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem)

'循环文件夹
Do While myFolderName <> ""
If myFolderName <> "." And myFolderName <> ".." Then '忽略当前目录和子目录
'确保得到的是文件夹
If (GetAttr(myPath & myFolderName) And vbDirectory) = vbDirectory Then
If myFolderName = myAppointFolderName Then
FindFolderInAppointFolder = myPath & myFolderName & ""

Exit Function
End If
End If
End If

myFolderName = Dir '得到下一个文件名
LoopEnd Function'批量复制文件到指定目录下的同名文件夹中
Private Sub cmdCopy_Click()
Dim myFSO As New Scripting.FileSystemObject
Dim myFolder As Scripting.Folder
Dim myFile As Scripting.File
Dim RootFolder As String

RootFolder = Text1.Text
Set myFolder = myFSO.GetFolder(RootFolder)
Dim i As Integer
i = 0
For Each myFile In myFolder.Files
Select Case UCase(myFile.Type)
Case "WL 文件"
'如果是线文件，则将它复制到指定目录下
Dim str_Destination As String
str_Destination = FindFolderInAppointFolder(Text2.Text, Left(myFile.Name, Len(myFile.Name) - 3))

'Debug.Print str_Destination
myFile.Copy str_Destination, True
i = i + 1
Case Else

End Select
Next

MsgBox "批量复制完毕，共赋值了" & i & "个文件", vbInformation, "批量复制"
End SubPrivate Sub cmdPath_Click(Index As Integer)
Dim myShell As New Shell32.Shell
Dim myRootFolder As Shell32.Folder3
Set myRootFolder = myShell.BrowseForFolder(0, "选择路径", 0)
'如果单击了取消键
If myRootFolder Is Nothing Then Exit Sub
Select Case Index
Case 0
Text1.Text = myRootFolder.Self.Path
Case 1
If Right(myRootFolder.Self.Path, 1) <> "" Then
Text2.Text = myRootFolder.Self.Path & ""
Else
Text2.Text = myRootFolder.Self.Path
End If
End Select
End SubPrivate Sub Form_Load()
'在亲、娘家文本框内读入路径
Dim strQinJ As String, strNiangJ As String
strQinJ = GetSetting("BatchCopy", "Path", "QinJia")
strNiangJ = GetSetting("BatchCopy", "Path", "NiangJia")

Text1.Text = strNiangJ: Text2.Text = strQinJ
End SubPrivate Sub Form_Unload(Cancel As Integer)
'将亲、娘家路径保存入注册表
SaveSetting "BatchCopy", "Path", "NiangJia", Text1.Text
SaveSetting "BatchCopy", "Path", "QinJia", Text2.Text
End Sub