批处理之家 - Powered by Discuz! Board

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

作者: 猪兜鸿 时间: 2015-9-28 13:53 标题: [已解决]vbs如何读取excel表格指定列中的文件名将文件移动到指定文件夹

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

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

作者: DAIC 时间: 2015-9-28 14:02

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

作者: 猪兜鸿 时间: 2015-9-28 14:36

回复 2# DAIC

作者: DAIC 时间: 2015-9-28 14:53

把excel导出到1.txt
第一列是文件名，第二列是文件夹名

@echo off
for /f "tokens=1-2" %%i in ('type "1.txt"') do (
    move /y "%%i.pdf" "%%j\"
)
复制代码

作者: 猪兜鸿 时间: 2015-9-29 08:48

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

作者: pcl_test 时间: 2015-9-29 11:17

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

没有原文件，不知道原文件如何，只能猜，有误自行修改

Set fso = CreateObject("Scripting.FileSystemObject")
fd = fso.GetFolder(".").Path
Set objExcel = CreateObject("Excel.Application")
Set objBook = objExcel.Workbooks.open(fd&"\测试.xls")
objBook.worksheets(1).activate  '设置第1个工作表为活动工作表
Set objSheet = objBook.activeSheet
For i=5 To 65535  '从第5行开始遍历
    If objSheet.Cells(i, 5).value = "" Then Exit For
    En = objSheet.Cells(i, 5).value  'E列
    Hn = objSheet.Cells(i, 8).value  'H列
    msgbox En &".pdf --> "& Trim(Hn)
    'If not fso.folderExists(Hn) Then fso.CreateFolder Trim(Hn)
    'If fso.fileExists(En&".pdf") Then CreateObject("Wscript.Shell").run "cmd /c move """&En&".pdf"" """&Trim(Hn)&"\""",0
Next
objBook.Close
objExcel.Quit
复制代码

作者: 猪兜鸿 时间: 2015-9-29 13:44

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

回复 6# pcl_test
解决问题了，谢谢斑竹。
我直接在excel里写VBA，贴上我的代码：

Sub 测试()
Dim fso, n As Long, m As Long
Set fso = CreateObject("scripting.filesystemobject")
Set WshShell = CreateObject("wscript.shell")
n = 0
m = 0
Do
n = n + 1
Kpath = "C:\Documents and Settings\admi\桌面\测试\报关单\" & Sheet1.Cells(n, 1).Value
If fso.folderExists(Kpath) Then
spath = "C:\Documents and Settings\admin\桌面\测试\文件夹\" & Sheet1.Cells(n, 2).Value & "\"
fso.CopyFolder Kpath, spath
fso.GetFolder(Kpath).Delete (True)
Else
m = m + 1
Sheet1.Cells(m, 3).Value = Sheet1.Cells(n, 1).Value
End If
Loop Until Sheet1.Cells(n + 1, 1).Value = ""
End Sub
复制代码

欢迎光临批处理之家 (http://www.bathome.net/)