重命名

ddz79101

老师！我希望根据表格中的新旧文件名对照，修改图片名。有代码，但无反应。请老师看看。谢谢

dragonthree

没有遍历文件夹，也没有name，怎么可能更改

ddz79101

dragonthree 发表于 2024-10-28 12:04
没有遍历文件夹，也没有name，怎么可能更改

谢谢老师！那么可以加个遍历文件夹吗

dragonthree

1. Sub 重命名()
   
2. '     x = InputBox("原名", "修改名")
   
3. '     On Error Resume Next
   
4. '     If [a2] = "" Then MsgBox "请点击第一步": Exit Sub
   
5. Set Sh1 = Sheet1
   
6. Set d = CreateObject("scripting.dictionary")
   
7. With Sh1
   
8.   arr = .Range("a2:c" & .Cells(.Rows.Count, 1).End(3).Row)
   
9. End With
   
10. For i = 1 To UBound(arr)
    
11.       d(arr(i, 1)) = arr(i, 3)
    
12. Next
    
13. s = ThisWorkbook.Path & "\图片"
    
14. s2 = Dir(s & "*.jpg")
    
15. Do While s2 <> ""
    
16.     If d.exists(s2) Then
    
17.         Name s & s2 As s & d(s2)
    
18.     End If
    
19.     s2 = Dir
    
20. Loop
    
21. MsgBox "改名已完成，请检查", vbOKOnly
    
22. End Sub

复制代码

longwin

Sub test()
arr = Sheets("图片名").[a1].CurrentRegion
fpath = ThisWorkbook.Path & "\图片\"
For i = 2 To UBound(arr)
    Name fpath & arr(i, 1) As fpath & arr(i, 3)
Next
End Sub

ddz79101

longwin 发表于 2024-10-28 12:14
Sub test()
arr = Sheets("图片名").[a1].CurrentRegion
fpath = ThisWorkbook.Path & "\图片\"

谢谢老师！运行成功！能修改为图片和改名代码不在同个文件夹下吗?

ddz79101

dragonthree 发表于 2024-10-28 12:12

谢谢老师！我这里改名没有成功吗？不知哪里出问题了？另能否修改为不在同个文件夹更名呀！

ddz79101

longwin 发表于 2024-10-28 12:14
Sub test()
arr = Sheets("图片名").[a1].CurrentRegion
fpath = ThisWorkbook.Path & "\图片\"

老师！修改为遍历文件夹，如何修改

ddz79101

dragonthree 发表于 2024-10-28 12:12

老师！修改为遍历文件夹，如何修改

gwjkkkkk

Option Explicit
Sub test()
    Dim strFileName$, strPath$, ar, i&
   
    strPath = ThisWorkbook.Path & "\图片\"
    ar = [A1].CurrentRegion.Value
   
    For i = 2 To UBound(ar)
        strFileName = strPath & ar(i, 1)
        If Dir(strFileName) <> "" Then Name strFileName As strPath & ar(i, 3)
    Next i

    Beep
End Sub