フォルダ フォルダ内の全てのファイル移動(同名存在削除)

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][フォルダ フォルダ内の全てのファイル移動(同名存在削除)]
Option Explicit


Sub FolderInFileMove()
'***********************************************
'フォルダ内の全てのファイル移動(同名存在削除)
'***********************************************
'移動先に同じ名前のファイルが存在する場合は削除
'手段は他にもあります。

Dim buf As String
Dim tgtPath As String
Dim OutPath As String
Dim DefaultFolderName As String
Dim NewFolderName As String
Dim ExtensionName As String

ExtensionName = "htm*" '指定してください"

DefaultFolderName = "元フォルダ"  '移動元フォルダ名
NewFolderName = "先フォルダ"          '移動先フォルダ名

tgtPath = ThisWorkbook.Path & "\" & DefaultFolderName
OutPath = ThisWorkbook.Path & "\" & NewFolderName

    buf = Dir(tgtPath & "\*." & ExtensionName)
    Do Until buf = Empty
        'FileCopyの場合は同名ファイルでもコピー(上書き)します。
        FileCopy tgtPath & "\" & buf, OutPath & "\" & buf
        buf = Dir()
    Loop
    'ファイルの存在確認
    If Dir(tgtPath & "\*." & ExtensionName) <> "" Then
        '元のファイルを削除します
        Kill tgtPath & "\*." & ExtensionName
    End If
End Sub


Sub FolderInFileMove2()
'***********************************************
'フォルダ内の全てのファイル移動(同名存在削除)
'***********************************************
'移動先に同じ名前のファイルが存在する場合は削除
'手段は他にもあります。

Dim buf As String
Dim tgtPath As String
Dim OutPath As String
Dim DefaultFolderName As String
Dim NewFolderName As String
Dim ExtensionName As String

ExtensionName = "htm*" '指定してください"

DefaultFolderName = "元フォルダ"  '移動元フォルダ名
NewFolderName = "先フォルダ"          '移動先フォルダ名

tgtPath = ThisWorkbook.Path & "\" & DefaultFolderName
OutPath = ThisWorkbook.Path & "\" & NewFolderName

    buf = Dir(tgtPath & "\*." & ExtensionName)
    Do While buf <> ""
        'FileCopyの場合は同名ファイルでもコピー(上書き)します。
        FileCopy tgtPath & "\" & buf, OutPath & "\" & buf
        buf = Dir()
    Loop
    'ファイルの存在確認
    If Dir(tgtPath & "\*." & ExtensionName) <> "" Then
        '元のファイルを削除します
        Kill tgtPath & "\*." & ExtensionName
    End If

End Sub







Production Japan Import Application. Since 1998