[已解决]文件的批量设置与批量移动

ccgqc

我有150个excel文件，文件名为：文件名1，文件名2……150,名称无规律

现在要让这些文件放到F盘9月工程文件夹里，对应的文件夹名(注意，些文件夹已有，名与要移动的文件名相同)

同时另有150个文件名均为上述文件前加材料清册，如：材料清册+文件名1，材料清册+文件名2，材料表文件名3，………150，也要放到同样的文件夹里，（注意，些文件夹为上述的同一文件夹）

以下给出三个文件夹：预算2，数据2，9月工程；现在要将预算2，数据2文件夹里的文件移动到9月工程里相相应的文件夹里
谢谢啦！

最佳答案

月排行榜 / 总排行榜

那么的帅

2014-4-4 00:55

ccgqc 发表于 2014-4-3 22:34
Sub move()
Dim MyPath1 As String, MyPath2 As String, MyName As String, MyName2 As String

1. Sub move1()
   
2.     Dim MyPath1 As String, MyPath2 As String, MyName1 As String, MyName2 As String, NewDir As String
   
3.     MyPath1 = "C:\Users\Administrator\Desktop\预算2"  '指定原始文件所在文件夹
   
4.     MyName1 = Dir(MyPath1 & "*.xls*")     ' 找寻第一项。
   
5.     Do While MyName1 <> ""      ' 开始循环。
   
6.         NewDir = Left(MyName1, InStr(MyName1, ".") - 1)  '返回文件名对应文件夹名
   
7.         MyPath2 = "F:\9月工程" & NewDir & ""  '指定文件新文件夹，需要事先创建该文件夹
   
8.         Name MyPath1 & MyName1 As MyPath2 & MyName1   '移动文件
   
9.         MyName1 = Dir    ' 查找下一个文件
   
10.     Loop
    
11. End Sub
    
12. Sub move2()
    
13.     Dim MyPath1 As String, MyPath2 As String, MyName1 As String, MyName2 As String, NewDir As String
    
14.     MyPath1 = "C:\Users\Administrator\Desktop\数据2"  '指定原始文件所在文件夹
    
15.     MyName1 = Dir(MyPath1 & "*.xls*")     ' 找寻第一项。
    
16.     Do While MyName1 <> ""      ' 开始循环。
    
17.         NewDir = Mid(MyName1, 5, InStr(MyName1, ".") - 5) '返回文件名对应文件夹名
    
18.         MyPath2 = "F:\9月工程" & NewDir & ""  '指定文件新文件夹，需要事先创建该文件夹
    
19.         Name MyPath1 & MyName1 As MyPath2 & MyName1   '移动文件
    
20.         MyName1 = Dir    ' 查找下一个文件
    
21.     Loop
    
22. End Sub

复制代码

跳转到最佳答案楼层

ccgqc

高手啊，高手

ccgqc

谁帮忙一下啊

蓝粆

建议文件可以少就少~~

ccgqc

谢谢，我在线等，文件少了说不清楚啊

ccgqc

Sub move()
Dim MyPath1 As String, MyPath2 As String, MyName As String, MyName2 As String

   MyPath1 = "C:\Users\Administrator\Desktop\预算2\"  '指定原始文件所在文件夹

   
   Do While MyName1 <> ""      ' 开始循环。

   
    filenaeme = Dir(MyPath1 & "*.xls*")     ' 找寻第一项。
        
    MyPath2 = "F:\9月工程\filenaeme\"    '指定文件新文件夹，需要事先创建该文件夹
   
    Name MyPath1 & MyName1 As MyPath2 & MyName1   '移动文件
   
    MyName1 = Dir    ' 查找下一个目录。
        
    Loop
   
End Sub
－－－－－－－－－－－
错在那里

那么的帅

ccgqc 发表于 2014-4-3 22:34
Sub move()
Dim MyPath1 As String, MyPath2 As String, MyName As String, MyName2 As String

1. Sub move1()
   
2.     Dim MyPath1 As String, MyPath2 As String, MyName1 As String, MyName2 As String, NewDir As String
   
3.     MyPath1 = "C:\Users\Administrator\Desktop\预算2"  '指定原始文件所在文件夹
   
4.     MyName1 = Dir(MyPath1 & "*.xls*")     ' 找寻第一项。
   
5.     Do While MyName1 <> ""      ' 开始循环。
   
6.         NewDir = Left(MyName1, InStr(MyName1, ".") - 1)  '返回文件名对应文件夹名
   
7.         MyPath2 = "F:\9月工程" & NewDir & ""  '指定文件新文件夹，需要事先创建该文件夹
   
8.         Name MyPath1 & MyName1 As MyPath2 & MyName1   '移动文件
   
9.         MyName1 = Dir    ' 查找下一个文件
   
10.     Loop
    
11. End Sub
    
12. Sub move2()
    
13.     Dim MyPath1 As String, MyPath2 As String, MyName1 As String, MyName2 As String, NewDir As String
    
14.     MyPath1 = "C:\Users\Administrator\Desktop\数据2"  '指定原始文件所在文件夹
    
15.     MyName1 = Dir(MyPath1 & "*.xls*")     ' 找寻第一项。
    
16.     Do While MyName1 <> ""      ' 开始循环。
    
17.         NewDir = Mid(MyName1, 5, InStr(MyName1, ".") - 5) '返回文件名对应文件夹名
    
18.         MyPath2 = "F:\9月工程" & NewDir & ""  '指定文件新文件夹，需要事先创建该文件夹
    
19.         Name MyPath1 & MyName1 As MyPath2 & MyName1   '移动文件
    
20.         MyName1 = Dir    ' 查找下一个文件
    
21.     Loop
    
22. End Sub

复制代码

ccgqc

http://www.excelpx.com/thread-325184-2-1.html
大侠，帮我看看啊

ccgqc

那么的帅 发表于 2014-4-4 00:55

http://www.excelpx.com/thread-325184-2-1.html
大侠，帮我看看