我正在使用这两个代码:
Option Explicit
Sub Get_Files_Information()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Set fo = fso.GetFolder(sh.Range("H1").Value)
Dim last_raw As Integer
For Each f In fo.Files
last_raw = sh.Range("A" & Application.Rows.Count).End(xlUp).Row + 1
sh.Range("A" & last_raw).Value = f.Name
Next
MsgBox "Done"
End Sub
Sub Rename_Files()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Dim new_name As String
Set fo = fso.GetFolder(sh.Range("H1").Value)
For Each f In fo.Files
> **new_name = Application.VLookup(f.Name, sh.Range("A:B"), 2, 0)**
f.Name = new_name
Next
MsgBox "Done"
End Sub
当Get_Files_Information正在获取文件名时,结果将带有文件扩展名。我想从文件名中排除文件扩展名,以使重命名不会由于文件扩展名而卡住。
此外,当我执行重命名代码时遇到错误时,我突出显示了代码类型不匹配运行时错误13。
我将附加excel宏文件作为参考。
https://drive.google.com/open?id=1Zivo3aIn-Id9XtgQu-qpOstL_j7eacjv
您能在这里帮我吗?
Application.VLookup(f.Name, sh.Range("A:B"), 2, 0)
是否返回错误(可能是由返回错误的公式(例如#VALUE)引起的)Sub Rename_Files()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Dim new_name As String
Set fo = fso.GetFolder(sh.Range("H1").Value)
For Each f In fo.Files
Dim vRes As Variant
vRes = Application.VLookup(f.Name, sh.Range("A:B"), 2, 0)
If IsError(vRes) Then
MsgBox "Cannot rename " & f.Name & " - " & CStr(vRes)
Else
new_name = vRes
f.Name = new_name
End If
Next
MsgBox "Done"
End Sub
此代码还将为您提供提示,因为它为您提供了cell error value。有关vlookup的扩展讨论,我建议看一下[article