[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フォルダ内の画像ファイルを探して抽出』（なおこ）
こんにちは
マクロ初心者ではございますが、ご教授頂ければ幸いです。
デスクトップのフォルダに複数の画像ファイルを保存しております。
それらの中で一つ一つファイル名を検索して探すのが大変でして
マクロでできないかと思いご相談です。
抽出したいファイル名をエクセルのA列に貼り付けておきます。
例)
d12954_1
54543_1
1234_1
今回全て探したい画像ファイル名の特徴は"_1"のついたファイル名です。
A列を一つ一つ一番した END(XLUP)などで一番したのセルまでを順番に指定した
フォルダ内を検索して他のフォルダに全てコピーするといったことは可能でしょうか？
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
_1 の付いたファイルは、全て画像ファイルなのでしょうか？ 別に画像に限らず、ファイル名が該当するものは全部処理してしまえば良いだけに思うのですが、ファイルの中身を調べて、画像かどうか判定する必要はあるのでしょうか？
出力先のフォルダは、デスクトップ以外でしょうか？ もしデスクトップに置いてしまうと、それも検索対象になってしまいそうです。
（???） 2018/02/09(金) 11:58
サブフォルダがたくさんございますが、メインフォルダは共通のフォルダに収納しております！
_1のついたファイル名は画像ファイルでございます。
画像かどうかの判別は必要ございません！
出力先はデスクトップかusbで考えておりました！
コード簡略化のためここのフォルダにしたほうが良いなどあればそのようにしたいと
思います(^^)
（なおこ） 2018/02/09(金) 12:30
デスクトップに「共通」というフォルダがあり、その下にサブフォルダや目的の画像があるものとした例なので、応用してください。 ちなみに、A列のファイル名文字列には、ワイルドカードも使えますので、*_1 なんて指定でもOKです。
Sub test()
Const cOut = "c:\temp\"
Dim cFiles As Variant
Dim cIn As String
Dim cFile As String
Dim i As Long
Dim j As Long
cIn = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\共通\"
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cIn & Cells(i, "A").Text & ".*""").StdOut().ReadAll(), vbNewLine)
For j = 0 To UBound(cFiles) - 1
cFile = Mid(cFiles(j), InStrRev(cFiles(j), "\") + 1)
FileCopy cFiles(j), cOut & cFile
Next j
Next i
End Sub
（???） 2018/02/09(金) 13:04
共通というフォルダ名の中にサブフォルダや画像ファイルを移して、
エクセルのa列にテストで9個のファイル名を入力して、実行致しましたが
処理後になにも起こりませんでした。
エラーがなければ最後に保存先を指定する画面がでるようなマクロでしょうか？？
上手くいったとすればどこに抽出されたのでしょうか？
（なおこ） 2018/02/09(金) 14:35
失礼致しました。共有とファイル名を間違えておりましたので修正後処理をしたところ、
デバックがでました。
FileCopy cFiles(j), cOut & cFile
こちらでとまってしまいました。
パスが見つかりません
というエラーメッセージでした
（なおこ） 2018/02/09(金) 14:37
すみません、コードが分かりませんでした。
抽出先のフォルダを新規作成でtempという名前にしました。
こちら右クリックしてプロパティの
場所：C:\Users\testPC\Desktop
のところをコピーして
Const cOut = "C:\Users\testPC\Desktop\temp"
としてみましたが
tempフォルダに入っておりませんでした（＞＜）
指定の仕方をご教授頂けますでしょうか？
desktopまででしたらデスクトップに画像ファイルが抽出できたのですが。。
（なおこ） 2018/02/09(金) 16:24
最後に\をつけたらデスクトップのtempフォルダに
画像がコピーされました！
有難うございます感激致しました。
最後に何件コピーしましたとmsgboxでださなくても、エラーが起きなければ
A列に用意したファイル名は全てフォルダからコピーしたと思って宜しいのでしょうか？
そうでない場合は何件コピーしました又は○○は見つかりませんでしたなど
表示するようにすることはできますでしょうか？
フォルダないにエクセルで用意したファイル名がもしかしたらない場合もございまして。。
（なおこ） 2018/02/09(金) 17:12
ちなみに、ファイルが見つからない場合は、UBound(cFiles) が -1 になります。
（???） 2018/02/09(金) 17:22
ご回答誠に有難うございます！
目的が少々変更致しまして、tempフォルダに抽出した画像ファイル名を全て
例)d12954_1 ⇒ d12954ss_1
と"ss"を足したファイル名にしたいのですが、
抽出ごとにファイル名にssをつけるか、抽出が終わった後に全ファイルにssをつけるなど
コードが組みやすい方でご教授頂けない？
（なおこ） 2018/02/11(日) 17:40
既に出力したファイルをリネームするのも、同じ考えで良いですよね。 Dir
関数で見つけたものを、順次 Name命令で変更するようなコードを書くだけです。
（???） 2018/02/12(月) 05:44
Option Explicit Sub TEST() Dim cFiles As Variant Dim cIn As String Dim i As Long, j As Long Dim FolderPath As String, FolderName As String
Dim WSH As Object
Set WSH = CreateObject("Wscript.Shell")
Dim DesktopPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダ選択"
.InitialFileName = ThisWorkbook.Path
If .Show = True Then
FolderPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
''' FolderPath →→ FolderName
DesktopPath = WSH.SpecialFolders("Desktop")
FolderName = Replace(FolderPath, DesktopPath, "")
''' (この間の２行、無理矢理です。一応動いてます。)
cIn = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & FolderName & "\"
cFiles = Split(CreateObject("WScript.Shell") _
.Exec("CMD /C DIR /A:-D/B/S """ & cIn & "*.*""") _
.StdOut().ReadAll(), vbNewLine)
For i = 0 To UBound(cFiles) - 1
MsgBox cFiles(i)
Next i
Set WSH = Nothing
End Sub
（高齢者マクラー） 2018/02/13(火) 22:46
FolderName = Mid(FolderPath, InStrRev(FolderPath, "\") + 1)
あと、CreateObject("WScript.Shell") を3箇所で使用していますが、WSHというオブジェクト変数に代入しているのだから、後の2箇所もWSHで置き換えられますよ。
（???） 2018/02/14(水) 11:12
FolderPath、FolderNameの２行は、
デスクトップのフォルダのサブフォルダを指定された場合の処理のために考えてみました。
CreateObject("WScript.Shell")の重複は、
色々なページを参考にさせていただいていて、コピーして使用したために生じました。
（高齢者マクラー） 2018/02/14(水) 12:48
Sub test()
Dim cFiles As Variant
Dim i As Long
Dim FolderPath As String
Dim WSH As Object
Set WSH = CreateObject("Wscript.Shell")
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダ選択"
.InitialFileName = ThisWorkbook.Path
If .Show = False Then
Exit Sub
End If
FolderPath = .SelectedItems(1)
End With
cFiles = Split(WSH.Exec("CMD /C DIR /A:-D/B/S """ & FolderPath & "\*.*"" | SORT").StdOut().ReadAll(), vbNewLine)
For i = 0 To UBound(cFiles) - 1
Cells(i + 1, "A").Value = cFiles(i)
Next i
Set WSH = Nothing End Sub （???） 2018/02/14(水) 13:25
早速ありがとうございました。
WSH.Exec("CMD /C DIR /A:-D/B/S "---------------------").StdOut().ReadAll(), vbNewLine)
の部分の記述方法が全く分からなかったものでお手数をおかけしました。
USBなどのデータもチェックしてみました。思っていた通りの結果です。
読み込み後のSORTは媒体のフォーマットの影響を避けたいためです。
帳票のブックから一覧表のシートへの転記を目的としており、
これで取得したファイル名のcFiles(i)のファイルを順に開いて処理してみます。
ファイルの選別など、こちらの方が再帰呼び出しよりも処理し易い気がしています。
とりあえずお礼まで。
（高齢者マクラー） 2018/02/14(水) 14:20
帳票ブックから一覧表へのデータの抽出作業に、
ExecuteExcel4Macroを使ってみたいとずっと思っていたのですが、
再帰呼び出しと組み合わせる自信がなくて使っていませんでした。
でも今回お教えいただいた方法なら何とかと思いテストしてみました。
250ブックから各30項目のデータを一覧表に整理する作業を行っていますが、
処理時間を1/10程度に短縮することができてストレスが無くなり、
大変感動しています。
今後とも色々とご教示くださいますようお願いいたします。
（高齢者マクラー） 2018/02/14(水) 19:17
先月はご指導頂き誠に有難うございました。
前回のお話では共通というフォルダの中にある画像をコピペするマクロでしたが、
共通フォルダの中にZIPのフォルダを入れても探してくれるコードはどのようにすれば宜しいでしょうか？
大量の画像のため解凍すると時間がかかるため、マクロでできれば非常に助かります。
（なおこ） 2018/03/20(火) 14:17
が、ちょっと面倒なので、このヒントだけでマクロ改造できないようならば、手作業でZIP解凍して対応した方が良いと思いますよ？（例えば、暗号化されたZIPが含まれる場合は、上記の方法では駄目なので、何らかの外部ツールと連動させるか、ZIPフォーマットを自力解析するコードを考えるかしないといけなくなります）
（???） 2018/03/20(火) 16:15
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.