指定条件フォルダ内の指定ファイルの自動コピーをしたいです。

以前類似の質問をし、回答でVBスクリプトのコードを書いていただきました。
http://q.hatena.ne.jp/1526039092
コードを流用できそうですが私は知識が無くうまくいきませんでした。

今回実現したいことは
フォルダAの下に多数のフォルダA-1,A-2,A-3等を作り、それらの中に複数枚(0~30枚)の画像ファイルを入れます。
このフォルダ群の中で11枚以上の画像ファイルが入っているフォルダを
フォルダBの下にコピーしたいです。
ただし番号の若いファイル10枚目まではコピーせずに11枚目以降のみをコピーします。

例えば
フォルダAの下のフォルダA-1には画像ファイルが8枚,A-2には10枚,A-3には13枚の場合には
フォルダBにフォルダA-3のフォルダのみをコピーし、そのフォルダの中にはA-3の中に入っていた画像ファイルのうち若いファイル名から数えて
11枚目~13枚目の3枚のみをコピーする。
というものです。

具体的なコードを記載いただけると大変助かります。
どうぞよろしくお願いいたします。
なおOSはwindows10です。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2019/09/09 20:46:35
  • 終了:2019/09/13 16:27:31

ベストアンサー

id:Silvanus No.1

Silvanus回答回数180ベストアンサー獲得回数712019/09/12 18:06:25

ポイント3000pt

お試し下さい。

Option Explicit

Dim objRecSet
Dim objFileSys
Dim objFolder
Dim objSubFolder
Dim objSubFolders
Dim strPath
Dim intCnt
Dim intNFiles
Dim strFileName
Dim strFNSorted

Const INT_N_FILES = 10 ' スキップするファイル数
Const STR_PATH_SRC = "C:\XXXXX" ' コピー元 親フォルダ
Const STR_PATH_DST = "C:\YYYYY" ' コピー先 親フォルダ

Const AD_VAR_CHAR = 200 ' adVarChar, ADO DataTypeEnum

Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSys.GetFolder(STR_PATH_SRC)
Set objSubFolders = objFolder.SubFolders

For Each objSubFolder In objSubFolders
  intNFiles = objSubFolder.Files.Count
  If objSubFolder.Files.Count > INT_N_FILES Then
    strPath = STR_PATH_DST & "\" & objSubFolder.Name
    If Not objFileSys.FolderExists(strPath) Then
      objFileSys.CreateFolder(strPath)
    End If
    Set objRecSet = CreateObject("ADODB.Recordset")
    Call objRecSet.Fields.Append("FileName", AD_VAR_CHAR, 255)
    Call objRecSet.Open()
    For Each strFileName In objSubFolder.Files
      Call objRecSet.AddNew()
      objRecSet.Fields("FileName").Value = strFileName.Name
    Next
    Call objRecSet.Update()
    objRecSet.Sort = "FileName ASC"
    strFNSorted = objRecSet.GetRows()
    Call objRecSet.Close()
    Set objRecSet = Nothing
    For intCnt = INT_N_FILES To intNFiles - 1
      Call objFileSys.CopyFile(objSubFolder & "\" & strFNSorted(0, intCnt), strPath & "\" & strFNSorted(0, intCnt), True)
    Next
  End If
Next

MsgBox "処理を終了しました。", vbOkOnly + vbInformation, "終了"
id:orekojinn

ただいま動かしてみました。希望通りの動きをすることを確認しました。
いつもありがとうございます。
m(_ _)m

2019/09/13 16:27:12
  • id:Silvanus
    「若いファイル名」というのは具体的にどういうことなんでしょうか?
  • id:orekojinn
    あっ! Silvanusさま
    どうも 先日もテキストファイルの保存形式の件でお世話になりました。
    ありがとうございました。

    「若いファイル名」という言い方が間違ってました。。すみません。
    何と言えばよいのでしょうか。
    フォルダの中に
    A001.JPG
    A002.JPG
    A003.JPG
    A004.JPG
    A005.JPG
    A006.JPG
    A007.JPG
    A008.JPG
    A010.JPG
    A011.JPG
    A100.JPG
    A111.JPG

    上記の12個の画像ファイルがある場合はこの通りの順番に並ぶかと思います。
    このファイルの並びの1番目から10番目はコピーの必要が無く
    11番目以降のみをコピーしたいです。
    上の例では
    A100.JPG
    A111.JPG
    のみがコピーされれば良いです。
    現在は12個の画像が全てコピーされます。
  • id:Silvanus
    此方こそ御世話になってます。
    「英字1文字+数字3桁」あるいは「末尾が数字3桁」という様にフォーマットが定まっているのでしょうか。いないのでしょうか。
  • id:orekojinn
    フォーマットは定まっています。.JPGの左にある5桁の数字が可変し、他は固定です。
    実際のファイル名のサンプルを記載します。
    IMG_01504.JPG
    IMG_09526.JPG
    IMG_09536.JPG

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません