[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[问题求助] [已解决]vbs如何读取excel表格指定列中的文件名将文件移动到指定文件夹

本帖最后由 pcl_test 于 2016-9-7 15:03 编辑

办公室小白一枚,有许多文件要归档,数量庞大。
    现在有一个excel文档,里面记录着要归档的文件名以及相对应要归档到的目的文件夹名称,但是都没有路径。
    还没有归档之前要归档的文件是放在同一个文件夹里面的,例如桌面。目的文件夹分好多个,也是放在一起的,所有文件都是pdf文件。
    自己尝试弄了一段bat,在for  /f 那里就挂掉了,只能移动一个文件,郁闷了。
    请各位大神帮忙写一下vbs代码,非常感谢!
1

评分人数

    • Batcher: 感谢给帖子标题标注[已解决]字样PB + 2

把excel的前三行发出来我看看

TOP

回复 2# DAIC

TOP

把excel导出到1.txt
第一列是文件名,第二列是文件夹名
  1. @echo off
  2. for /f "tokens=1-2" %%i in ('type "1.txt"') do (
  3.     move /y "%%i.pdf" "%%j\"
  4. )
复制代码

TOP

回复 4# DAIC
能不能用VBS直接读取excel内容,然后移动文件?这样弄到txt上数据太多了,好麻烦

TOP

本帖最后由 pcl_test 于 2015-9-29 11:19 编辑

没有原文件,不知道原文件如何,只能猜,有误自行修改
  1. Set fso = CreateObject("Scripting.FileSystemObject")
  2. fd = fso.GetFolder(".").Path
  3. Set objExcel = CreateObject("Excel.Application")
  4. Set objBook = objExcel.Workbooks.open(fd&"\测试.xls")
  5. objBook.worksheets(1).activate  '设置第1个工作表为活动工作表
  6. Set objSheet = objBook.activeSheet
  7. For i=5 To 65535  '从第5行开始遍历
  8.     If objSheet.Cells(i, 5).value = "" Then Exit For
  9.     En = objSheet.Cells(i, 5).value  'E列
  10.     Hn = objSheet.Cells(i, 8).value  'H列
  11.     msgbox En &".pdf --> "& Trim(Hn)
  12.     'If not fso.folderExists(Hn) Then fso.CreateFolder Trim(Hn)
  13.     'If fso.fileExists(En&".pdf") Then CreateObject("Wscript.Shell").run "cmd /c move """&En&".pdf"" """&Trim(Hn)&"\""",0
  14. Next
  15. objBook.Close
  16. objExcel.Quit
复制代码
1

评分人数

TOP

本帖最后由 猪兜鸿 于 2015-9-29 13:48 编辑

回复 6# pcl_test
解决问题了,谢谢斑竹。
我直接在excel里写VBA,贴上我的代码:
  1. Sub 测试()
  2. Dim fso, n As Long, m As Long
  3. Set fso = CreateObject("scripting.filesystemobject")
  4. Set WshShell = CreateObject("wscript.shell")
  5. n = 0
  6. m = 0
  7. Do
  8. n = n + 1
  9. Kpath = "C:\Documents and Settings\admi\桌面\测试\报关单\" & Sheet1.Cells(n, 1).Value
  10. If fso.folderExists(Kpath) Then
  11. spath = "C:\Documents and Settings\admin\桌面\测试\文件夹\" & Sheet1.Cells(n, 2).Value & "\"
  12. fso.CopyFolder Kpath, spath
  13. fso.GetFolder(Kpath).Delete (True)
  14. Else
  15. m = m + 1
  16. Sheet1.Cells(m, 3).Value = Sheet1.Cells(n, 1).Value
  17. End If
  18. Loop Until Sheet1.Cells(n + 1, 1).Value = ""
  19. End Sub
复制代码

TOP

返回列表