エクセルVBA 名前の競合と一括移動

質問

フォルダの中にある複数のサブフォルダを一度に移動先フォルダに移動させたいと考えています。いろいろ参考にして、下のようにコードを用意しています。これで移動前のフォルダを指定した後、移動後のフォルダをしていして、移動することができました。ただしこれだと一つ一つのフォルダについて選択しなくてはならず、理想とはいえません。
改良して次の点を付加したいのですが、どのようにするのかわからずつまずいています。
(条件)
・移動先のフォルダの中にはサブフォルダがある階層。
・フォルダ名は英数字6～9文字
追加したい点は
1.一度に「移動前」のフォルダ内のサブフォルダを「移動先」フォルダの中に移動する。

2.名前が競合した場合は、「移動先」フォルダの中にすでにあるサブフォルダの中に移動する

という機能を付加したいのですが、行き詰っています。お知恵を拝借できないでしょうか？

Sub FolderMove()
Dim SourcFolderSpec, DestFolderSpec As String
Dim SourcFolder_Object, DestFolder_Object As Object
Dim FileNamePath As Variant

SourcFolderSpec = FolderPath

If SourcFolderSpec = "" Then
End
End If
DestFolderSpec = FolderPath

If DestFolderSpec = "" Then
End
End If

Set SourcFolder_Object = CreateObject _
("Scripting.FileSystemObject").GetFolder(SourcFolderSpec)

DestFolderSpec = DestFolderSpec & "\"

SourcFolder_Object.Move DestFolderSpec

End Sub

回答No.4

Wendy02 · ベストアンサー

こんにちは。#3 です。

#Const MYCMD1 As String = "CMD /C MOVE " '末尾は半角スペースを開>ける

これは、MS-DOS（コマンドプロンプト）のMOVE コマンドで行っています。
この方法が、一番早いはずです。

Win9x 系では、COMMAND.COM /C としていました。

#中身は、ショートネームで実行されています。

コマンドプロンプト上で、8.3 形式のファイル名で収まらないと、以下のようになるはずです。
"Stock Charts with Added Series.htm" (ロングネーム）
　　　　↓
"STOCKC~1.HTM"　（ショートネーム）

ということです。

お礼

早速ありがとうございました。私の理解の遥か先を行くことのようでした。解説ありがとうございました。

回答No.3

Wendy02

こんにちは。

ご説明の意図に見えない部分がありますが、こんな感じはどうかな？

>2.名前が競合した場合は、「移動先」フォルダの中にすでにあるサブフォルダの中に移動する

ただし、一回限りです。中身は、ショートネームで実行されています。

Win 9x 系は不可（変更は可能）

'-------------------------------------
Sub MoveDirectries()
　　Dim SourceFolder As String
　　Dim SourceDir As String
　　Dim DestFolder As String
　　Dim DestDir As String
　　Dim ArDirs() As String
　　Dim FOLname As String
　　Dim i As Integer
　　Dim v As Variant
　　Dim ret As Integer

　　'Win 2000以上
　　Const MYCMD1 As String = "CMD /C MOVE " '末尾は半角スペースを開ける

　　SourceFolder = ActiveWorkbook.Path & "\" 'ベースのフォルダ（元）\ は必ず付ける
　　DestFolder = ActiveWorkbook.Path & "\" 'ベースのフォルダ（先）\ は必ず付ける

　　SourceDir = SourceFolder & "Test1Fold\"　'末尾に\ は付けなくてよい
　　DestDir = DestFolder & "Test1AFold\"

　　'最終フォルダに　\ があったら省く
　　If Right(SourceDir, 1) = "\" Then SourceDir = Mid$(SourceDir, 1, Len(SourceDir) - 1)
　　If Right(DestDir, 1) = "\" Then DestDir = Mid$(DestDir, 1, Len(DestDir) - 1)

　　ReDim Preserve ArDirs(i)
　　FOLname = Dir(SourceDir & "\", vbDirectory)
　　Do While FOLname <> ""
　　　　If FOLname <> "." And FOLname <> ".." Then
　　　　　　If (GetAttr(SourceDir & "\" & FOLname) And vbDirectory) = vbDirectory Then
　　　　　　　　ReDim Preserve ArDirs(i)
　　　　　　　　ArDirs(i) = FOLname
　　　　　　　　i = i + 1
　　　　　　End If
　　　　End If
　　　　FOLname = Dir
　　Loop
　　'フォルダの下のフォルダを作るのは一回のみ
　　For Each v In ArDirs()
　　　　If Dir(DestDir & "\" & v, vbDirectory) = "" Then
　　　　　ret = Shell(MYCMD1 & """" & SourceDir & "\" & v & """" & " " & """" & DestDir & """")

　　　　ElseIf Dir(DestDir & "\" & v & "\" & v, vbDirectory) = "" Then
　　　　　　ret = Shell(MYCMD1 & """" & SourceDir & "\" & v & """" & " " & """" & DestDir & "\" & v & """")
　　　　End If
　　Next v
End Sub

補足

ありがとうございました。これはすごいですね。ためさせていただいたのですが、うまくいきました。
初めて聞く技がたくさんあり、少し調べたのですが、よくわかりませんでした。
>中身は、ショートネームで実行されています。
>Const MYCMD1 As String = "CMD /C MOVE " '末尾は半角スペースを開>ける

この部分がまったくわかりません。どのようなことをしているのでしょうか？簡単で結構なので教えていただけると助かります。

回答No.2

KenKen_SP

Windows の動作としては移動先に同名のフォルダがある場合、通常
ユーザーに判断を仰ぐか、または上書きします。

> 2.名前が競合した場合は、「移動先」フォルダの中にすでにある
> サブフォルダの中に移動する

この仕様だと、

> 「移動先」フォルダの中にすでにあるサブフォルダの中

に再度同名フォルダがある場合、さらに深い階層にフォルダを移動
させることになるのでしょうか？
Windows のパス長の制限に引っかかりそうですから、あまり現実的
ではないと思いますが....

　　参考：Windows のファイル名長さの制限
　　・Windows 9x 系　　絶対パスを含めて 255 バイト
　　・Windows NT 系　　全角半角に関わらず 255文字 まで
　　　※厳密には 260文字まで予約されているが、エクスプローラ
　　　　からは、255文字までにか入力できない

この辺はどのようにお考えですか？

お礼

ファイル名長さの制限ということまでは考えていませんでした。まだまだです。ありがとうございました。

回答No.1

kigoshi

条件のなかの「移動先のフォルダの中にはサブフォルダがある階層」の意味が今一歩理解できていませんが。

とりあえず「移動」ではなくて「複写」して元を「削除」という手順ではいかがでしょう。

具体的には最後の１行
SourcFolder_Object.Move DestFolderSpec
を
SourcFolder_Object.Copy DestFolderSpec
SourcFolder_Object.Delete
にすると良いように思います。

ただし、同名のファイルがあったときは上書きされると思います。

お礼

ありがとうございます。参考になりました。