【VBA】フォルダAにある2つのファイルの内１つを、フォルダBへ。もう１つを、フォルダBへ移動したい

タイトルの件、ご存じの方は教えて下さい。

フォルダAの中には、下記の条件のとおり
２つのファイルがあります。


【やりたい事】↓

ファルダAの中にある２つのファイルがあります。

１つ目は、ファイル名に_aが付いていない。
⇒例：123abc.pdf　

もう１つは、ファイル名前に_aが付いている
⇒123abc_a


【マクロにしたいところ】
●１目のファイルはAフォルダへ
【フォルダAの中身移動後：123abc.pdf】


●もう１つはBフォルダへ
【フォルダAの中身移動後：123abc_a.pdf】


VBAを利用して、移動したいです

【補足】
１回のマクロで、Aフォルダ２つのファイルが
Bフォルダ、Cフォルダへ移動して欲しいです。


【フォルダAにあるファイルの条件】
・個数⇒常に２個

・種類の種類⇒２個とも主にPDF、他、エクセル、パワーポイント、テキストなど

・ファイルの名前

⇒1つ目：文字の数や種類は、数値、ローマ字などいろいろ。決まりないです。
⇒例：123abc.pdf　ああああ.pdf、

⇒2つ目：上記１つ目のファイルの末尾【拡張子の前】に　_a　が必ずついている。例：123abc_a、ああああ_a.pdf

※要は、２つのファイルがあり。
⇒１つ目は　abc123.pdf
⇒２つ目は１つ目の名前に_aが付いたファイル
⇒abc123_a.pdf　

【フォルダAのパス】
C:\Users\2020\Desktop\フォルダA

【フォルダBのパス】
C:\Users\2020\Desktop\フォルダB

【フォルダCのパス】
C:\Users\2020\Desktop\フォルダC

質問者からの補足コメント

• ばっちしできました。ありがとうございます。

  No.5の回答に寄せられた補足コメントです。 補足日時：2022/07/26 22:57

No.6 回答者： tatsumaru77 回答日時： 2022/07/27 08:38

フォルダA内のファイルのチェックを厳密に行いました。

Option Explicit
Public Sub ファイル移動()
Const FolderA As String = "C:\Users\2020\Desktop\フォルダA"
Const FolderB As String = "C:\Users\2020\Desktop\フォルダB"
Const FolderC As String = "C:\Users\2020\Desktop\フォルダC"
Dim fsys As Object
Dim fdir As Object
Dim ffiles As Object
Dim mfile As Object
Dim fname(1) As String
Dim elm As Variant
Dim ctr As Long: ctr = 0
Dim elen As Long: elen = 0
Dim x As Long
Dim i As Long
Dim src As String
Dim trg As String
Dim ext(1) As String
If dir(FolderA, vbDirectory) = "" Then
MsgBox (FolderA & "が存在しません")
Exit Sub
End If
If dir(FolderB, vbDirectory) = "" Then
MsgBox (FolderB & "が存在しません")
Exit Sub
End If
If dir(FolderC, vbDirectory) = "" Then
MsgBox (FolderC & "が存在しません")
Exit Sub
End If
Set fsys = CreateObject("Scripting.FileSystemObject")
Set fdir = fsys.GetFolder(FolderA)
Set ffiles = fdir.Files
If ffiles.Count <> 2 Then
MsgBox (FolderA & "内のファイル数が不正")
Exit Sub
End If
i = 0
For Each mfile In ffiles
elm = Split(mfile.Name, ".")
If UBound(elm) < 1 Then
MsgBox (mfile & "に拡張子なし")
Exit Sub
End If
x = UBound(elm)
elen = Len(elm(x))
ext(i) = Right(mfile.Name, elen)
If LCase(Right(elm(x - 1), 2)) = "_a" Then
ctr = ctr + 1
fname(0) = mfile.Name
Else
fname(1) = mfile.Name
End If
i = i + 1
Next
If ctr <> 1 Then
MsgBox ("_aのファイル数不正")
Exit Sub
End If
If LCase(ext(0)) <> LCase(ext(1)) Then
MsgBox ("拡張子不一致")
Exit Sub
End If
src = FolderA & "\" & fname(0)
trg = FolderB & "\" & fname(0)
fsys.movefile src, trg
src = FolderA & "\" & fname(1)
trg = FolderC & "\" & fname(1)
fsys.movefile src, trg
MsgBox ("移動完了")
End Sub

No.5 回答者： Qchan1962 回答日時： 2022/07/26 21:40

>上記のVBAを連続して、そのまま、書いて　end　subで終わればいいのでしょうか？

ハイ

Sub MoveFile_Sample()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim 移動元ファイル As String
Dim 移動先ファイル As String
'１回目
移動元ファイル = "C:\Users\2020\Desktop\フォルダA\*_a.*"
移動先ファイル = "C:\Users\2020\Desktop\フォルダC"
fso.MoveFile 移動元ファイル, 移動先ファイル
'2回目(残りを移動)
移動元ファイル = "C:\Users\2020\Desktop\フォルダA\*"
移動先ファイル = "C:\Users\2020\Desktop\フォルダB"
fso.MoveFile 移動元ファイル, 移動先ファイル

End Sub

No.4 回答者： tatsumaru77 回答日時： 2022/07/26 12:44

補足要求です。

１．フォルダA内には必ず２つのファイルがあるということですが、
仮に３つあった場合は、処理しないでOKですか？

２．フォルダA内には、必ず同じ拡張子のファイルが格納されていますか。
①abc123.pdf
②abc123_a.pdf　の場合は理解できますが

①abc123.pdf
②abc123_a.txt　
のように拡張子がことなる場合もありますか。

この回答へのお礼

お問合せありがとうございます。

１⇒常に２つです。２つの場合は、処理しないでOKです。
２⇒常に同じ拡張子です。

以上、大変、お手数ですが、教えてくださいませ。

お礼日時：2022/07/26 20:24

No.3 回答者： Qchan1962 回答日時： 2022/07/26 12:03

こんにちは

移動だけならこの方法が良いと思いましたので
https://oshiete.goo.ne.jp/qa/13056261.html
で回答しました
Scripting.FileSystemObjectについて調べて頂く為にも参考先のみ提示しました
返信が無かったので回答先を理解されたのだと思いましたが・・・
応用すれば、容易に出来ますね。

考え方？処理の手順をよく考えてみましょう

2つに分ける時に　特徴のある（一意で分けられる）ものから処理するべきです
ですので、先ずは　_a　の付くファイル名が対象になります
一意性を高める為、拡張子前の.を付加して

移動元ファイル = "C:\Users\2020\Desktop\フォルダA\*_a.*"
移動先ファイル = "C:\Users\2020\Desktop\フォルダC"
fso.MoveFile 移動元ファイル, 移動先ファイル

先に、この処理をすると残るのは　_a　が無いファイルですね
もう分けられている状態ですが、

C:\Users\2020\Desktop\フォルダBに移動したいのなら

もう一度　ファイルパスを変更して実行すれば良いと思います

移動元ファイル = "C:\Users\2020\Desktop\フォルダA\*"
移動先ファイル = "C:\Users\2020\Desktop\フォルダB"
fso.MoveFile 移動元ファイル, 移動先ファイル

2回の繰り返し処理の様になっていますが、取り敢えず、そのままでも良いでしょう


＊移動元ファイル・移動先ファイル　は、ざっくり名です

この回答へのお礼

回答ありがとうございます。

２回の繰り返しを⇒１回のマクロ実行で実施するのは難しいですか？
上記のVBAを連続して、そのまま、書いて
　end　subで終わればいいのでしょうか？

ご教授の程、宜しくお願いします。

お礼日時：2022/07/26 20:49

No.2 回答者： 銀鱗 回答日時： 2022/07/26 09:38

ああ、タイトル間違ってるのね。

何言ってるんだ？って思ったよ。

てか、質問本文もおかしなことになってるｗ

・・・本題・・・

ファイル名を取得して、その文字列にアンダーバー(_)が含まれるかどうかで
処理を分岐させれば良い。

・「Aフォルダ」にあるファイル名を１つ取得する。
・文字列にアンダーバーが含まれるか検査。
・「アンダーバーがあれば」そのファイルを
　「Bフォルダ」に移動させる。
・「アンダーバーが無ければ」そのファイルを
　「Cフォルダ」に移動させる。

(´・ω・`) 基本はこんなもん。
この手順の中で何が分からないのかを考え、改善方法を自身でインターネット上を検索してみましょう。

No.1 回答者： KenKen_SP 回答日時： 2022/07/26 09:34

こんにちは。

Windowsのエクスプローラ右上ファイル検索で
1. *_a.*で絞り込み
2. 全選択
3. ファイル移動
4. 残ったものも移動

の４ステップでできることです。手動でいいと思いますけど、勉強目的なんですかね、、？

ファイル名で分岐処理することになりますけど、

IF InStr(1, filename, "_a") >0 Then
　　フォルダ移動処理
End If

何回かご質問されてる様ですけど、基本は一緒です。
動かなくても良いし、コピペでもいいので、まずはご自身で考えたことを出さないと、ただの作成依頼で終わりますよ。