vba修改word文件名

1.如何用VBA快速修改文件名

Sub 批量改名（）

Dim FolderName As String, wbName As String, cValue As Variant

Dim wbList() As String, wbCount As Integer, i As Integer, str As String, exname As String

FolderName = "G:\360data\重要数据\桌面\新建文件夹" '文件夹路径

'创建文件夹中工作簿列表

wbCount = 0

wbName = Dir(FolderName & "\" & "*.xls*")

While wbName <> ""

wbCount = wbCount + 1

ReDim Preserve wbList(1 To wbCount)

wbList(wbCount) = wbName

wbName = Dir

Wend

If wbCount = 0 Then Exit Sub

'从每个工作簿中获取数据

For i = 1 To wbCount

cValue = GetInfoFromClosedFile(FolderName, wbList(i), "sheet1", "a1")

exname = Mid(wbList(i), InStr(wbList(i), "."))

Name FolderName & "\" & wbList(i) As FolderName & "\" & cValue & exname

On Error Resume Next

Name FolderName & "\" & wbList(i) As FolderName & "\" & cValue & i & exname

Next i

End Sub

'====================从未打开表中获取信息===========================

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _

wbName As String, wsName As String, cellRef As String) As Variant

Dim arg As String

GetInfoFromClosedFile = ""

If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"

If Dir(wbPath & "\" & wbName) = "" Then Exit Function

arg = "'" & wbPath & "[" & wbName & "]" & _

wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)

r = 0

On Error Resume Next

GetInfoFromClosedFile = ExecuteExcel4Macro(arg)

End Function

2.求EXCEL VBA批量修改文件名的代码示例

办公室有个批量更改照片的 占个位置 明天上班再贴 半夜懒重写了。

目标：为学员照相 导入电脑并批量修改为学号加姓名

1、首先建立一个EXCEL表 其中第一个工作薄名称为照相顺序表 如下图

Sub 照片重命名（）

If MsgBox（"程序将重命名与本工作薄同目录下的所有照片文件，确认这样做么？"， vbYesNo） 6 Then

Exit Sub

End If

Dim oldname As String '旧文件名变量oldname

Dim newname As String '新文件名变量newname

Dim photopath As String '路径变量photopath

Dim nophoto As String '错误提示变量nophoto

Dim i As Integer '循环变量i

photopath = ThisWorkbook.Path '为要修改的文件名路径复制为当前excel文件的路径

For i = 2 To Worksheets（"照相顺序表"）.Range("a65536").End(xlUp).Row '开始循环 从“照相顺序表”工作薄的a2单元格开始

'为新文件名变量赋值为路径变量& \ & 照相顺序表工作薄中的a2&b2单元格内容加上扩展名.jpg

newname = photopath & "\" & Worksheets（"照相顺序表"）.Cells(i, 1).Text & Worksheets（"照相顺序表"）.Cells(i, 2).Text & ".jpg"

'为旧文件名变量赋值为路径变量& \ & 照相顺序表工作薄中的c2单元格内容&扩展名.jpg

oldname = photopath & "\" & Worksheets（"照相顺序表"）.Cells(i, 3).Text & ".jpg"

'判断旧文件名是否在当前目录存在

If Dir(oldname) "" Then

Name oldname As newname '存在则改名

Else

nophoto = nophoto & Chr(10) & oldname'不存在则将其赋值给错误提示变量并以回车分割累加

End If

Next i

If nophoto "" Then

MsgBox nophoto & Chr(10) & "图片不存在" '存在错误提示则弹出错误提示框

End If

End Sub

备注是刚添加的 希望有所帮助，另外求分谢谢。

3.VBA怎样实现 批量选择word文档读取其文件名并填表 的功能

Sub Test()

Dim f, n, x, wb, fName

On Error Resume Next

Cells.Clear

'打开文件（可多选）

f = Application.GetOpenFilename("Word文件，*.docm,", 1， "选择文件"， MultiSelect:=True)

'遍历每个选择的文件

For x = 1 To UBound(f)

sFile = f(x)

'取文件名，并赋值给单元格

n = Len(sFile) - InStrRev(sFile, "\")

fName = Right(sFile, n)

Cells(x, 1) = Left(fName, InStr(fName, " ") - 1） '取1到空格前的字符

'Cells(x, 1) = Left(fname, 9) '取文件名的前9个字符

Cells(x, 2) = Mid(fName, InStr(fName, " ") + 1, Len(fName) - InStr(fName, ".") + 1） '取空格后到点之前的字符

'Cells(x, 2) = Mid(fName, 10, Len(fName) - InStr(fName, ".") + 1） '从10开始取到点之前的字符

Next x

End Sub

4.用vba打开word模板并修改后保存

1、打开Word文件的 VBA编辑器，快捷键 Alt+F11，右击【ThisDocument】-》 【插入模块】； 用VBA代码设置Word自动保存的步骤 2、双击刚才插入的【模块1】，添加如下代码： Sub 自动备份（） Dim NewTime NewTime = Now + TimeValue(“00:05:10”) Dim myPath$, myName$ myPath = ActiveDocument.Path myName = Left$(ActiveDocument.Name, Len(ActiveDocument.Name) - 4) ChangeFileOpenDirectory myPath ActiveDocument.SaveAs FileName:=myName & “_temp.doc”, ReadOnlyRecommended:=True ActiveDocument.SaveAs FileName:=myName & “.doc”, ReadOnlyRecommended:=False Application.OnTime NewTime， “自动备份” CreateObject(“Wscript.shell”).popup “备份成功，备份文件名为：” & myName & “_temp.doc”, 2， “提示！2秒后自动关闭！” End Sub 用VBA代码设置Word自动保存的步骤 用VBA代码设置Word自动保存的步骤 3、双击【ThisDocument】并在其中 添加如下代码： Private Sub Document_Open() Call 自动备份 End Sub 用VBA代码设置Word自动保存的步骤 4、默认自动备份时间为5min，如要调整请修改【模块1】中一句代码：如图中红框所示： 时间格式为：HH : mm : ss 用VBA代码设置Word自动保存的步骤 5、保存代码及文件，且关闭word并重新打开，重新打开点击【选项】-》 【启用此内容】，如图： 用VBA代码设置Word自动保存的步骤 6、默认备份文件名为：【原文件名_temp,Lee.doc】且为只读，提示对话框2s后自动关闭。

备份效果显示如下： 。

5.利用VBA批量重置指定格式文件名

在任意Word文档中新建一宏，将下列代码粘贴到此宏中，执行此宏即可完成任务'以下是需要复制的vba代码：On Error Resume Next：'本例代码将指定文件夹中的指定类型文件按 A+4位顺序号 重命名Dim i As IntegerDim Str1 As StringDim PathStr As StringDim FileTypeStr As StringDim NewName As StringDim ObjfsoDim ObjfoldersPathStr = InputBox（"请输入需要处理的文件所在的文件夹路径：" & vbCrLf & "如：d：\下载图片"， "文件夹名称"）If PathStr = "" Or Dir(PathStr, vbDirectory) = "" Then MsgBox "文件夹输入错误，操作被取消！"， vbInformation， "提示" Exit SubEnd IfIf Right(PathStr, 1) = "\" Then PathStr = Left(PathStr, Len(PathStr))End IfFileTypeStr = InputBox（"请输入需要处理的文件类型：" & vbCrLf & "如：jpg 或者 png 等"， "文件类型"， "jpg"）If Len(FileTypeStr) <> 3 Then MsgBox "文件类型输入错误，操作被取消！"， vbInformation， "提示" Exit SubEnd IfSet Objfso = CreateObject("Scripting.FileSystemObject")Set Objfolders = Objfso.GetFolder(PathStr)FileTypeStr = "." & LCase(FileTypeStr)For Each objFile In Objfolders.Files Str1 = objFile.Name Str1 = LCase(Str1) '过滤格式进行重命名 If InStr(1, Str1, FileTypeStr) <> 0 Then i = i + 1 '格式化新文件名 NewName = PathStr + "\" & "A" & Format(i, "0000") & FileTypeStr '与新文件同名将被忽略 Objfso.MoveFile objFile, NewName End IfNextSet Objfolders = NothingSet Objfso = NothingMsgBox "重命名过程执行完毕！"， vbInformation， "提示"i = Shell("explorer.exe " & PathStr, vbNormalFocus)。

转载请注明出处51数据库 » vba修改word文件名