如何批量把第一行的字更改word的文件名

juan1266

守柔版主，可以像７楼一样做成一个直接可使用的文件吗？非常感谢．

juan1266

QUOTE:

以下是引用守柔在2008-1-25 21:13:08的发言：

请参考:

请参考：
Option Explicit

Sub Example()
    Dim MyDialog As FileDialog, vrtSelectedItem As Variant
    Dim myArray() As String, OldName As String, thisPath As String
    Dim NewName As String
    '    On Error Resume Next
    '定义一个文件夹选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
    With MyDialog
        .Filters.Clear    '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件
        .AllowMultiSelect = True    '允许多项选择
        If .Show = -1 Then    '确定
            thisPath = .InitialFileName
            For Each vrtSelectedItem In .SelectedItems    '在所有选取项目中循环
                NewName = GetFileTitle(thisPath, vrtSelectedItem)
                If NewName <> "" Then
                    Name vrtSelectedItem As thisPath & NewName & ".doc"
                End If
            Next vrtSelectedItem
        End If
    End With
End Sub
Function GetFileTitle(apath, strFl) As String
'请在VBE/工具/引用中勾选对于MICROSOFT SHELL CONTROLS AND AUTOMATION
    Dim shl As Shell32.Shell
    Dim shfd As Shell32.Folder
    Dim Flname As String
    Set shl = New Shell
    Set shfd = shl.NameSpace(apath)
    Flname = VBA.Replace(strFl, apath, "")
    GetFileTitle = shfd.GetDetailsOf(shfd.Items.Item(Flname), 10)
End Function
'MsgBox ActiveDocument.BuiltInDocumentProperties(wdPropertyTitle) '返回活动文档属性值

守柔版主，可以像７楼一样做成一个直接可使用的文件吗？非常感谢．

tangqingfu

QUOTE:

以下是引用守柔在2007-11-5 6:40:22的发言：

            For Each oArray In ErrArray '遍历替换
                oldName = Replace(oldName, oArray, "")
            Next
            myDoc.Close False '关闭文档
            If Len(oldName) < 1 Then '如果长度小于1不处理
            Else '进行重命名操作
                newName = .InitialFileName & oldName & ".doc"
                '如果当前文件夹中没有此文件名
                If Dir(newName, vbDirectory) = "" Then
                    Name oDoc As newName '直接命名
                Else '如果存在,则按时间序列数加命名
                    newName = Replace(newName, ".doc", "")
                    newName = newName & Timer
                    newName = Replace(newName, ".", "")
                    newName = newName & ".doc"
                    Name oDoc As newName
                End If
            End If
        Next
    End With
End Sub
'----------------------

单击附件中的“开始重命名Word文件“（常用工具栏中）即可。

谢谢守版，收藏使用！

eureka2

非常感谢，守柔版主帮了我大忙了！文件名顺利更改成功！

zjgwzj

原帖由 守柔 于 2008-1-25 21:13 发表
QUOTE:以下是引用zmstock在2008-1-25 16:07:58的发言：如何按DOC文件标题批量修改文件名请参考:请参考：Option ExplicitSub Example()&nbsp; &nbsp; Dim MyDialog As FileDialog, vrtSelectedItem As Variant&nbsp;  ...

守版，运行你提供的代码时出现错误，详见附图所示，麻烦解决一下吧，谢谢。

秋日的枫叶

做个记号，还是很有用的

独孤

找了好久才找到的好东东，厉害，学习了

kissjiaoao

谢谢分享！超级实用

嗨一修

守柔 发表于 2007-11-5 06:40
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each oArray In ErrArray '遍历 ...

怎么用，没看懂大哥？

ofaye

守柔 发表于 2007-11-5 06:40
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each oArray In ErrArray '遍历 ...

请教：如果想指定其他行，如第二行或者第三行内容为文件名，应该修改什么参数？