ここから本文です

VBSの質問です。 ご回答いただける方々、いつもありがとうございます。 以下...

tak********さん

2019/3/214:18:50

VBSの質問です。

ご回答いただける方々、いつもありがとうございます。

以下のファイル移動させるVBSのプログラムを
ご教示いただけますでしょうか。

具体的には、
Aフォルダ、Bフォルダ・・と複数フォルダが存在します。

Aフォルダ内直下に、
Aファイル_20190227
Aファイル_20190228
サブフォルダ(A1901、A1902)が存在します。

Bフォルダ内直下に、
Bファイル_20190227
Bファイル_20190228
サブフォルダ(B1901、B1902)が存在します。

そこで、メッセージboxにファイル末尾0227を
入力後、引き続き、メッセージboxに
1902を入力すると、Aファイル_20190227は、
A1902へ移動、Bファイル_20190227は、
B1902 へ移動するプログラムをご教示していただけませんでしょうか。

お手数ですが、よろしくお願いいたします。

閲覧数:
38
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

lin********さん

2019/3/221:10:50

「移動前のファイル名」も「移動先のフォルダ名」の入力も、「4桁の数字」という前提条件です。

プログラムファイルを「Aフォルダ」や「Bフォルダ」直上のフォルダに置いて実行してください。

Option Explicit
Dim f, gf, m, n, s, so, x
Do Until Len(m) = 4 and IsNumeric(m) = True
m = InputBox("移動したいファイル")
Loop
Do Until Len(n) = 4 and IsNumeric(n) = True
n = InputBox("移動先")
Loop
Set so = CreateObject("Scripting.FileSystemObject")
Set gf = so.GetFolder(so.GetParentFolderName(WScript.ScriptFullName))
For Each s In gf.SubFolders
For Each f In s.Files
If Right(so.GetBaseName(f.Name), 4) = m Then
For Each x In s.SubFolders
If Right(x.Name, 4) = n Then
so.MoveFile s & "\" & f.Name, x & "\" & f.Name
End If
Next
End If
Next
Next
Set gf = Nothing
Set so = Nothing
MsgBox("Finished!")

簡単な説明です。

Do Until Len(m) = 4 and IsNumeric(m) = True
m = InputBox("移動したいファイル")
Loop

「Until Len(m) = 4 and IsNumeric(m) = True」で入力された値が「4文字」でなおかつ、その4文字が、数値として評価できるまで、入力を求め続けます。

Set so = CreateObject("Scripting.FileSystemObject")
Set gf = so.GetFolder(so.GetParentFolderName(WScript.ScriptFullName))

「Windows」のファイルやフォルダを扱う機能を読み込み、プログラムファイル自身が存在するフォルダを取得しています。

For Each s In gf.SubFolders

プログラムファイルが存在するフォルダ内のすべてのサブフォルダを1つずつ調べます。

For Each f In s.Files

見つかったサブフォルダ内のすべてのファイルを1つずつ調べます。

If Right(so.GetBaseName(f.Name), 4) = m Then

「GetBaseName(ベースネーム)」は、「abc.txt」→「abc」です。

見つかったファイルのファイル名のベースネームの右側4文字が入力した最初の値と一致したら、

For Each x In s.SubFolders

そのサブフォルダ内に存在するすべてのサブフォルダを1つずつ調べます。

If Right(x.Name, 4) = n Then

見つかったサブフォルダの名前の右側4文字が移動先に入力した値と一致したら、

so.MoveFile s & "\" & f.Name, x & "\" & f.Name

ファイルを移動しています。

質問した人からのコメント

2019/3/3 14:26:31

ご回答、プログラムのご解説ありがとうございます。
大変助かりました。正常に動作いたしました。

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる