[问题求助] [已解决]VBS从XLS固定单元格取值并重命名XLS文件名

marginal

在一个文件中，有一堆的XLS文件，其名字可以分为三类：一类为形如Bok_EP2_A400YY.xls；第二类为形如Inv_ep2_A400YY.xls；第三类为形如Pac_EP2_A400YY.xls。其实BOK，Inv，Pac三份文件为一整套文件。整套文件的判断标准看每一个文件名的第二个“_"后的字符，如果字符相同，就是同一套文件。比如Bok_EP2_A400YY.xls；Inv_ep2_A400YY.xls；Pac_EP2_A400YY.xls其第二个“_"后的字符都为A400YY，那么这三个文件就是同一套文件。

需要取Bok_EP2_A400YY.xls文件的D4单元格值，并将取得的值用来重命名整套文件XLS文件，比如Bok_EP2_A400YY.xls文件的D4单元格为5782042200，那么需要将Bok_EP2_A400YY.xls重命名为5782042200 bok.xls，Inv_ep2_A400YY.xls重命名为5782042200 inv.xls；Pac_EP2_A400YY.xls重命名为5782042200 pac.xls。因为这几个是一套文件。

请看附件。
代码在2楼
感谢qaz123654

qaz123654

保存为vbs在xls目录运行

On Error Resume Next
Dim fName
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(".")
readxls("Bok")
readxls("")
msgbox "完成"
Set objFS = Nothing
Set objFolder = Nothing
Function readxls(str)
For each f in objFolder.Files
fName=split(f.Name,"_")
If right(f.Name,4) = ".xls" and ubound(fName)=2 and fName(0) <> str then
Set oExcel = CreateObject( "Excel.Application")
oExcel.WorkBooks.Open(createobject("wscript.shell").currentdirectory&"\Bok_"&fName(1)&"_"&fName(2))
fName1=oExcel.Cells(4,4).Value
oExcel.Quit
Set oExcel = Nothing
f.Name= fName1&" "&fName(0)&".xls"
End If
Next
End Function 
复制代码

[ 本帖最后由 qaz123654 于 2010-7-15 12:40 编辑 ]

marginal

谢谢qaz123654
可能是我表达不清楚，在XLS文件夹中并不是每次都有Bok_EP2_A400YY.xls，事实上，路径应该跟VBS文件路径相同。即VBS放在什么文件夹下，就对该文件夹下的XLS文件其作用。
另外，我发现现在的代码只能更改Bok_EP2_A400YY这一套的名字，其它的文件都不能更改。
结果如下图：

qaz123654

是从以Bok_EP2_开头的文件中读取吗？

marginal

原帖由 qaz123654 于 2010-7-14 17:48 发表
是从以Bok_EP2_开头的文件中读取吗？

是的，读取所有Bok_EP2_文件中的D4单元格。

marginal

再次感谢qaz123654
第一次的代码我发现，每次运行只能更改1套文件。将更改好的文件剪切出去后，再运行VBS文件可以又改一套。也就是每次运行，只能更改一套文件而不能循环更改。

第二次的代码，运行后，只能更改BOK文件，其它配套的的INV,PAC不能更改，而且，好像只能改几个BOK文件，其它的BOK文件没有变化。第二次的运行结果;

qaz123654

代码更新到2楼，测试了下似乎可用，效率就差了点

marginal

原帖由 qaz123654 于 2010-7-15 12:46 发表
代码更新到2楼，测试了下似乎可用，效率就差了点

已经可以了，多谢qaz123654.