如何根据文件地址批量复制文件到指定位置？

Question

请参考复制代码：
Sub Test()
    ''假如目标在F列
    Dim i As Long, k As Long, tPath As String
    k = 200 ''最后一列的行号
    tPath = "d:\files\" ''目标目录
    With Sheet1
        For i = 1 To k
            CopyFiles .Range("f" & i).Value, tPath
        Next
    End With
End Sub
Sub CopyFiles(ByVal bFullFile As String, ByVal bMulu As String)
    ''说明：bMuLu是指定的目录，可以使用对话框来设置
    ''复制文件时没有考虑是否有重名的，如果需要，自己判断一下
    Dim ww
    If Right$(bMulu, 1) <> "\" Then bMulu = bMulu & "\"
    ww = Split(bFullFile, "\")
    FileCopy bFullFile, bMulu & ww(UBound(ww))
End Sub
如果文件地址在sheet1的F列

Answer 1

cao楼上的兄弟，回复得晚了些。因为一直在用你的方法在做，本想在别人提醒下自己搞出来，自己也动动脑筋，看来还是不行，不是搞这行的，基础比较差。实际的情况是如图，我的文件地址都是放在access的表格里的，然后有一个按钮，我要点击按钮后，所列出来的这些文件都会自动复制到某个文件夹。我用你的代码，提示说要求对象。可否再帮我实现下，谢谢了。

Answer 2

这不就是读取数据库吗。Option Explicit
Dim conn As Connection
Dim rs As Recordset
Dim db As String, connstr As String, strs As StringPrivate Sub Form_Load()
    Set conn = New Connection
    Set rs = New Recordset
    
    '这儿改为你自己的数据库文件名
    db = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\") & "Access.MDB"
    If Dir(db) = "" Then Unload Me
    connstr = "provider=Microsoft.JET.OLEDB.4.0;Data Source=" & db
    conn.Open connstr
End SubPrivate Sub Form_Unload(Cancel As Integer)
    Set conn = Nothing
    Set rs = Nothing
End SubPrivate Sub Command1_Click()
    Dim tPath As String
    tPath = "D:\抽题\"
    
    '这儿的myFiles改为你自己的表名
    strs = "Select * from myFiles"
    rs.Open strs, conn, 1, 1
    Do While Not rs.EOF
        FileCopy rs("试题文件地址"), tPath & rs("文件名")
        rs.MoveNext
    Loop
    rs.Close
End Sub

Answer 3

如果不经常使用，用Excel打开access数据库，然后使用#1代码，不过需要修改几个地方：
1、将sheet1改成打开access后的表名；
2、for i=1 to k这里的1要修改成2，因为打开数据库后第一行是标题；
3、看看文件地址是不是f列，如果不是修改成对应的列名
然后执行就可以了如果需要经常这么做，那就按照直接操作数据库的方式来操作，如#5楼

Answer 4

假定WinRAR安装在C:\Program Files\WinRAR文件夹下，比如要把所有文件保存到d:\mydir文件夹下（前提是没有文件重名，否则会提示是否覆盖同名文件）在Excel中将“文件地址”列另存为d:\filelist.txt
在cmd窗口中输入以下命令：
cd /d d:\
c:\progra~1\winrar\rar a -m0 tmprar @filelist.txt
cd /d d:\mydir
c:\progra~1\winrar\rar e d:\tmprar
del d:\tmprar

Answer 5

最后一句del d:\tmprar应改为del d:\tmprar.rar