Results of 1 - 1 of about 71 for ExecuteExcel4Macro 閉じた｜開いて｜開かず (0.012 sec.)
executeexcel4macro (140), 閉じた (629), 開いて (4904), 開かず (263)
- [[20180209104636]]
- #score: 14119
- @digest: d1b93dea2127264f255ffd4fb36c3f0f
- @id: 75479
- @mdate: 2018-03-20T07:15:00Z
- @size: 11027
- @type: text/plain
- #keywords: cfiles (26160), 帰呼 (16384), folderpath (14838), foldername (13553), 齢者 (12262), 者マ (11942), 高齢 (10623), 像フ (8025), ブフ (7577), 再帰 (7407), ォル (6346), stdout (6003), filecopy (5987), wscript (5679), ルダ (5435), readall (5253), デス (5212), vbnewline (5004), cfile (4771), フォ (4688), desktop (4594), トッ (4290), ル名 (4200), ファ (4141), サブ (4113), 画像 (3785), selecteditems (3444), shell (3256), ァイ (3206), filedialog (3178), specialfolders (3176), 共通 (3100)
- 『フォルダ内の画像ファイルを探して抽出』（なおこ）
こんにちは マクロ初心者ではございますが、ご教授頂ければ幸いです。 デスクトップのフォルダに複数の画像ファイルを保存しております。 それらの中で一つ一つファイル名を検索して探すのが大変でして マクロでできないかと思いご相談です。 抽出したいファイル名をエクセルの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 ---- cOut は、先頭で定数定義しています。貴方が出力して欲しいフォルダのパスに書き換えてくださいね。（コードを読まずに実行するのは無謀…） （???） 2018/02/09(金) 15:54 ---- ???様 すみません、コードが分かりませんでした。 抽出先のフォルダを新規作成でtempという名前にしました。 こちら右クリックしてプロパティの 場所:C:¥Users¥testPC¥Desktop のところをコピーして Const cOut = "C:¥Users¥testPC¥Desktop¥temp" としてみましたが tempフォルダに入っておりませんでした（＞＜） 指定の仕方をご教授頂けますでしょうか? desktopまででしたらデスクトップに画像ファイルが抽出できたのですが。。 （なおこ） 2018/02/09(金) 16:24 ---- フルパス指定末尾に、"¥" を1文字追加してみてください。 デスクトップに、フォルダ名とファイル名がくっついてコピーされていませんでしたか? （???） 2018/02/09(金) 16:48 ---- ???様 最後に¥をつけたらデスクトップのtempフォルダに 画像がコピーされました! 有難うございます感激致しました。 最後に何件コピーしましたとmsgboxでださなくても、エラーが起きなければ A列に用意したファイル名は全てフォルダからコピーしたと思って宜しいのでしょうか? そうでない場合は何件コピーしました又は○○は見つかりませんでしたなど 表示するようにすることはできますでしょうか? フォルダないにエクセルで用意したファイル名がもしかしたらない場合もございまして。。 （なおこ） 2018/02/09(金) 17:12 ---- 何行目の処理かは、i で判ります。 何件該当したかは、UBound(cFiles) で判ります。なので、Cellsを使ってB列にでも結果表示してみてはいかがでしょうか。（あり/なしではなく件数にするのは、ワイルドカードを指定すると、1行で複数ファイル処理できるからです） ちなみに、ファイルが見つからない場合は、UBound(cFiles) が -1 になります。 （???） 2018/02/09(金) 17:22 ---- ???様 ご回答誠に有難うございます! 目的が少々変更致しまして、tempフォルダに抽出した画像ファイル名を全て 例)d12954_1 ⇒ d12954ss_1 と"ss"を足したファイル名にしたいのですが、 抽出ごとにファイル名にssをつけるか、抽出が終わった後に全ファイルにssをつけるなど コードが組みやすい方でご教授頂けない? （なおこ） 2018/02/11(日) 17:40 ---- ファイル名中に、他に _1 が無いのならば、FileCopy 先を Replace(cFile, "_1", "ss_1") とするとか? 既に出力したファイルをリネームするのも、同じ考えで良いですよね。 Dir 関数で見つけたものを、順次 Name命令で変更するようなコードを書くだけです。 （???） 2018/02/12(月) 05:44 ---- ??? 様 大変興味深く読ませていただき、 現在再帰呼び出しで作成しているマクロを、示されている方法で書き換えてみたいと思っています。 FileDialogでフォルダを選択し、SelectedItems(1)からフォルダ名を分離して取り出したく、 色々テストしてみましたがうまくいきません。 何か良い方法があるのでしょうか? お教えいただければ幸いです。 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, "") ''' (この間の2行、無理矢理です。一応動いてます。) 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 ---- ??? 様 ありがとうございます。 再帰呼び出しの代わりに応用して、最初に全てのファイル名を取得してソートし、 順に処理できないかなと思っています。 再帰呼び出しの場合、最下層フォルダを指定された場合の処理が出来てはいるのですが、 どうしても理解できない点があったりします。 でも、データがDeskTopかMyDOcuments以外のUSBなどにある場合は難しそうですし… もう少し考えてみます。 FolderPath、FolderNameの2行は、 デスクトップのフォルダのサブフォルダを指定された場合の処理のために考えてみました。 CreateObject("WScript.Shell")の重複は、 色々なページを参考にさせていただいていて、コピーして使用したために生じました。 （高齢者マクラー） 2018/02/14(水) 12:48 ---- フルパスで並び替えるならば、コマンドプロンプトのSORTコマンドを組合わせることもできますよ。 ファイル名部分だけで並び替えるならば、ファイル一覧を得た後でソートになりますけど。 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圧縮ファイルということですね。Shell.Application と CopyHere を調べると、外部オブジェクトを使ったZIPの展開例が見つかるかと思います。 拡張子がZIP だった場合、テンポラリフォルダを用意し、ここに展開し、目的のファイル名ならコピーするよう、処理追加すれば良いでしょう。 が、ちょっと面倒なので、このヒントだけでマクロ改造できないようならば、手作業でZIP解凍して対応した方が良いと思いますよ?（例えば、暗号化されたZIPが含まれる場合は、上記の方法では駄目なので、何らかの外部ツールと連動させるか、ZIPフォーマットを自力解析するコードを考えるかしないといけなくなります） （???） 2018/03/20(火) 16:15... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201802/20180209104636.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97056 documents and 608292 words.
訪問者：