抛砖引玉之一－－－文件名批量重命名

sdbbsdbb

新年新岁，旧人复来，先给各位拜个晚年。 大约也是在去年这个时间，发现了这块宝地，并找到了守大虾，从此，单调乏味的生涯变得精彩丰富起来。 我是个电子书迷，不但爱看，更喜欢制作，但能弄到手的成品永远是那么少。因此，俺不得自力更生，艰苦创造...... 电子书处理过程中，有两大麻烦，一是用同样的方法对不同的数据进行处理(比如，对一百个同样格式的网页文件进行相应的处理，如用手工就得一百次，但如利用一些程序则可一步完成)；二是文件名的处理。因此，我就产生了用VB来操作WORD，来进行“批处理”的想法。 不过那时的水平太烂（如今的水平也烂，不过比起那时，好像还明白多一点），那里的思路是用VB中的SHELL命令启动WORD（那时还根本不懂VBA，根本不知道如何通过别的途径“控制”WORD），再用SENDKEYS方法来执行WORD中的命令，结果，成功倒是成功了，不过成功率为40%上下，有一大半可能是失败滴..... 因此，当找到菜园、找到守大虾，我的激动心情也就很正常了。只可惜，流年不利，去年下半年，我几乎米时间花在VBA上，浪费了不少时间....... 新年新气象，我又一次回到了菜园，相信这次的回归将成就　VBA＋电子书处理　这一新的课题。 先说第一个问题：如何将一批文件名中的时间格式转化为通用格式？ 样本如下所示： 2002年6月03日　给地球照相　（郭华东）.txt 2002年6月04日　古希腊和中国古代的物种的分类　（杰弗瑞·劳埃德）.txt 2002年6月05日　科学的语言　（杰弗瑞·劳埃德）.txt 2002年6月10日　数学与天文　（张顺燕）.txt 2002年6月11日　一门应用广泛的学科——应用统计（上）　（谢衷洁）.txt 2002年6月12日　一门应用广泛的学科——应用统计（下）　（谢衷洁）.txt 2002年6月13日　寻找宇宙中最基本的粒子（上）　（丁肇中）.txt 2002年6月14日　寻找宇宙中最基本的粒子（下）　（丁肇中）.txt 2002年6月27日　微型飞机的现状、未来及挑战　（宋笔锋）.txt 2002年6月28日　移民与中国　葛剑雄.txt 2002年6月6日　疾病诊断的金标准　（朱世能）.txt 2002年6月7日　化学与人类健康　（刘旦初）.txt 2002年7月1日　《红楼梦》的空间叙事艺术　（张世君）.txt 2002年7月2日　谜语之谜：艺术逻辑基本原理　（董小英）.txt 目标格式： 20020614　寻找宇宙中最基本的粒子（下）　（丁肇中）.txt 20020627　微型飞机的现状、未来及挑战　（宋笔锋）.txt 20020628　移民与中国　葛剑雄.txt 20020606　疾病诊断的金标准　（朱世能）.txt 20020607　化学与人类健康　（刘旦初）.txt 20020701　《红楼梦》的空间叙事艺术　（张世君）.txt 我的原始办法： Dim FSO As Object, FDR As Object, F As Object, i As Variant, OldName As String, NewName As String On Error Resume Next '忽略错误 t1 = Timer Set FSO = CreateObject("Scripting.FileSystemObject") '创建计算机文件系统以向其访问 Set FDR = FSO.GetFolder("D:\Test") '指定其中访问的文件夹对象 Set F = FDR.Files '定义该文件夹中的所有文件集合 For Each i In F '在指定文件下的文件中循环 OldName = FDR & "\" & i.Name nameA = Mid(i.Name, 1, 11) '先将时间部分部分进行分离，单独处理 nameA1 = Mid(nameA, 1, 5) '这是年度部分（例如“2002年”），永久不变 nameA2 = Mid(nameA, 6) '这是年度部分之后的内容，它会随着单、双月的不同而发生变化 If Mid(nameA, 7, 1) = "月" Then nameA2 = "0" & nameA2 '这一步之后，时间部分中的月度已经变成了双数（例如“01月”） nameA3 = Mid(nameA2, 1, 3) '这是不变的双数月份（例如“01月”） nameA4 = Mid(nameA2, 4) '这是月数部分后的内容，日期还有单、双之别（例如“21日”“3日”） If Mid(nameA2, 5, 1) = "日" Then nameA4 = "0" & nameA4 '这之后的日期都统一变成了双数（例如“03日”） nameA = nameA1 & nameA3 & nameA4 '这是经过处理的双数（即为2002年01月03日）“时间部分” nameA = Replace(nameA, "年", "") nameA = Replace(nameA, "月", "") nameA = Replace(nameA, "日", "") 　'这是经过处理的双数（即为20020103）“时间部分” nameB = Mid(i.Name, 12) '这是文件名中的“正文部分”，这部分内容中的“年、月、日”等字样不会发生变化 nameB = Replace(nameB, "。", ".") NewName = FDR & "\" & nameA & nameB ' Name OldName As NewName Next i t2 = Timer MsgBox t2 - t1 以上程式可满足初步要求，但仍有下列不足。 之一： 原始处理方法的效率是否太低？ 之二： 本样本中的“年月日”（即“时间部分”）之后全为两个半角空格，如果只有一个或米有空格，将如何处理？ 之三：样本中的“年月日”均处于首位，如果不在首位（诸如下列情况）时，该如何处理？ [YYTvO]06.01.02.百家讲坛_唐诗的故事01_李白出道之谜－康震 06.01.03.百家讲坛_唐诗的故事02_李白翰林之谜－康震 [YYTvO]06.01.04.百家讲坛_唐诗的故事03_李白遭谗之谜－康震 老大、孔兄以及坛中的各位大虾，请指教，谢谢了。

守柔

我放在家里了，下班后给你传（论坛上）过去。

sdbbsdbb

多谢了，不过能帮我看看我的代码么？出现这么多冗余和低效的东东也真非我本意。

老大的代码太强，我的东东太烂，虾米时候能多学会老大的三招二式就好了。

守柔

以下是引用[I]sdbbsdbb[/I]在2006-2-5 12:10:56的发言：

多谢了，不过能帮我看看我的代码么？出现这么多冗余和低效的东东也真非我本意。

老大的代码太强，我的东东太烂，虾米时候能多学会老大的三招二式就好了。

你先测试一下我的代码再说。
Option Explicit
Sub NewNames()
    Dim MyDialog As FileDialog, vrtSelectedItem As Variant, oChar As Range
    Dim OldName As String, NewName As String, fileName As String, myArray() As String
    Dim myDate As Date, myString As String
    '    On Error Resume Next    '忽略错误
    '定义一个文件夹选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
    With MyDialog
        .Filters.Clear    '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件'此处修改为"所有TXT文件","*.TXT",1
        .AllowMultiSelect = True    '允许多项选择
        If .Show = -1 Then    '确定
            For Each vrtSelectedItem In .SelectedItems    '在所有选取项目中循环
                OldName = vrtSelectedItem
                myArray = VBA.Split(OldName, Application.PathSeparator)
                fileName = myArray(UBound(myArray))
                With ActiveDocument.Content
                    .Text = fileName
                    For Each oChar In .Words
                        If VBA.IsDate(oChar) = True Then
                            myDate = oChar.Text
                            myString = oChar.Text
                            Exit For
                        Else
                            myString = ""
                        End If
                    Next
                End With
                If myString = "" Then
                Else
                    NewName = VBA.Replace(OldName, myString, VBA.Format(myDate, "YYYYMMDD"))'根据你所需要的内容设置日期格式
                    '                    Debug.Print NewName
                    Name OldName As NewName
                End If
            Next
        End If
    End With
End Sub

[此贴子已经被konggs于2006-11-28 12:39:31编辑过]

sdbbsdbb

怎一个“强”字了得！

成功，并且效率高，代码好看，比我的东东不知要好多少倍。

不过原理米全部看懂（主要是那个IsDate米用过），今天得回去研究研究了，明天再请教噢

konggs

山地步兵兄客气了，

祝你新年好，也祝老大新年好！大家新年都好！

看了老大的代码，受益不浅。

我只能贴到isDate的帮助：

返回 Boolean 值，指出一个表达式是否可以转换成日期。

IsDate(expression)

必要的 expression 参数是一个 Variant，包含日期表达式或字符串表达式，这里的字符串表达式是可以作为日期或时间来认定的。

说明：如果表达式是一个日期，或可以作为有效日期识别，则 IsDate 返回 True；否则返回 False。在 Microsoft Windows 中，有效日期的范围介于公元 100 年 1 月 1 日与公元 9999 年 12 月 31 日之间；其有效范围随操作系统不同而不同。

我也有处不明！

就是：

Name OldName As NewName

这个是干什么的？

守柔

TO KONGGS：

Name 语句

重新命名一个文件、目录、或文件夹。

语法

Name oldpathname As newpathname

Name 语句的语法具有以下几个部分：

部分 描述

oldpathname 必要参数。字符串表达式，指定已存在的文件名和位置，可以包含目录或文件夹、以及驱动器。

newpathname 必要参数。字符串表达式，指定新的文件名和位置，可以包含目录或文件夹、以及驱动器。而由 newpathname 所指定的文件名不能存在。

说明

Name 语句重新命名文件并将其移动到一个不同的目录或文件夹中。如有必要，Name 可跨驱动器移动文件。 但当 newpathname 和 oldpathname 都在相同的驱动器中时，只能重新命名已经存在的目录或文件夹。 Name 不能创建新文件、目录或文件夹。

在一个已打开的文件上使用 Name，将会产生错误。必须在改变名称之前，先关闭打开的文件。Name 参数不能包括多字符 (*) 和单字符 (?) 的统配符。

如果在WORD中，当然可以使用另存为的方法，但效率不高，而且又新增了很多文件。

相关链接：

http://club.excelhome.net/viewthread.php?tid=148824

http://www.officefans.net/cdb/viewthread.php?tid=51782&fpage=1&highlight=shell

plxmm

学习ing。

konggs

谢谢老大，收到，学习ing.

再祝：狗年“旺旺”！

ouyang9465

收到，学习ing