在excel中重命名多个文件

问题描述 投票:0回答:1

我正在使用这两个代码:

  1. Get_Files_Information:要从excel的文件夹中提取文件名以进行重命名:
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
  1. 重命名文件:此代码将重命名文件名:
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

您能在这里帮我吗?

excel vba
1个回答
0
投票
尝试以下代码。它将检查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
© www.soinside.com 2019 - 2024. All rights reserved.