Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


22538 / 76732 ←次へ | 前へ→

【59574】Re:A列のファイル名を検索し、B列のファイル名に変換
回答  Fso提案  - 08/12/23(火) 8:11 -

引用なし
パスワード
   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

0 hits

【59571】A列のファイル名を検索し、B列のファイル名に変換 K.J 08/12/22(月) 19:49 質問
【59572】Re:A列のファイル名を検索し、B列のファイ... マクロマン 08/12/22(月) 20:02 発言
【59574】Re:A列のファイル名を検索し、B列のファイ... Fso提案 08/12/23(火) 8:11 回答
【59731】Re:A列のファイル名を検索し、B列のファイ... K.J 09/1/5(月) 10:44 お礼

22538 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free