| |
FsoにあるメソッドでのSampleです。
Sub Sample()
Dim myPath As String
Dim v As Variant, i As Long, j As Long
Dim key As Variant
'myPath = CreateObject("Wscript.Shell").Specialfolders("Desktop") & "\tmp\"
myPath = "C:\tmp\"
'A,B列を配列に取得する
v = Sheet1.Range("A1").CurrentRegion.Resize(, 2).Value
'変更後の名称に同一名があれば連番を振る
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(v)
.Item(v(i, 2)) = .Item(v(i, 2)) + 1
Next
For Each key In .Keys
If .Item(key) > 1 Then
j = 0
For i = 1 To UBound(v)
If v(i, 2) = key Then
j = j + 1
v(i, 2) = v(i, 2) & "_" & Format$(j, "00")
End If
Next
End If
Next
End With
'FSOのMoveFileで名前の付け直しを行う
With CreateObject("Scripting.FileSystemObject")
For i = 1 To UBound(v)
' If .FileExists(myPath & v(i, 1)) Then
On Error Resume Next
.MoveFile myPath & v(i, 1), myPath & v(i, 2)
If Err <> 0 Then
MsgBox Err.Description, _
vbExclamation, _
v(i, 1) & "→" & v(i, 2)
End If
On Error GoTo 0
' End If
Next
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
