- ベストアンサー
マクロで特定のフォルダの中から任意のフォルダを開きたい
cistronezkの回答
- cistronezk
- ベストアンサー率38% (120/309)
Sub Mcr1() Dim dic As New Scripting.Dictionary '参照設定で「Microsoft Scripting Runtime」をチェック Dim lastestFile As String, lastestDate As Date, i As Integer '「保存データ」以下のフォルダにある全ファイル名と作成日時情報を取得 GetAllFiles "保存データ", dic '最新のｘｌｓファイルを取得 For i = 0 To dic.Count - 1 If lastestDate < dic.Item(dic.keys(i)) And LCase(Right(dic.keys(i),4)) = ".xls" Then lastestFile = dic.keys(i) lastestDate = dic.Item(lastestFile) End If Next i If lastestFile<> "" Then Workbooks.Open (lastestFile) End If End Sub Private Sub GetAllFiles(strPath As String, dic As Scripting.Dictionary) Dim fso As Object, fl As Object, fldr As Object, subfldr As Object Set fso = CreateObject("Scripting.FileSystemObject") Set fldr = fso.GetFolder(strPath) For Each fl In fldr.files 'ファイルのパスをキー、作成日時をitemとして格納 dic.Add fl.Path, fl.DateCreated Next For Each subfldr In fldr.SubFolders GetAllFiles subfldr.Path, dic Next Set fldr = Nothing Set fso = Nothing End Sub
関連するQ&A
- サブフォルダからエクセルブックをとりだすマクロ
特定のフォルダからエクセルブックのみを抽出し別のフォルダに集める（コピーする）マクロを作りたいと思い、以下のように作成しました。 （AAAフォルダ⇒移動元、BBBフォルダ⇒移動先） ただしこれだと、AAAフォルダ内にあるサブフォルダからは拾ってこれないようです。 AAA内の全てのサブフォルダからエクセルブックを拾ってくるにはどう修正すればよろしいでしょうか。 ――――――――――― Sub sample1() Dim FSO As Object, fld As Variant, bk As Variant Const Fld1 As String = "C:\AAA" Const Fld2 As String = "C:\BBB\" Const tgt As String = "*.xlsx" Set FSO = CreateObject("Scripting.FileSystemObject") For Each fld In FSO.GetFolder(Fld1).SubFolders For Each bk In fld.Files If bk.Name Like tgt Then bk.Copy Fld2 End If Next bk Next fld End Sub
- 締切済み
- Excel（エクセル）
- フォルダーの中に特定ファイルを開くの続きですが
フォルダーの中に特定ファイルを開くの続きですが 次の命令を書きましたが実行できないです。間違った所を教えてほしいです 見積番号とはフォームの中のテキストボックスです。それをクリックする関連するエクセルファイルが開くようにしたいですのでよろしくお願いします。 Private Sub 見積番号_Click() Dim LngRet As Long Dim stLinkCriteria As String Dim Ipath As String Ipath = "\\C:\全社員共通\[見積書]\見積\" stLinkCriteria = Ipath & "\" & 見積番号 & "*.xls" LngRet = ShellExecute(0, vbNullString, Ipath & stLinkCriteria, _ vbNullString, vbNullString, 1) End Sub
- ベストアンサー
- その他(データベース)
- 部分検索でフォルダ名を検索するマクロ
Excel2013、windows8を利用しています。 任意の文字を入力して、その文字を含むサブフォルダを検索するマクロを考えています。 以下の例ではフォルダパス\\000.00.000.00\ab\c\内のサブフォルダから、ワタナベという文字 を含むサブフォルダ名のみを検索し、サブフォルダ名をvbaのイミディエイトに結果を出力するマクロを作ったつもりなのですが正しく動きません（エラーが出るわけでは無いのですが何も出力されない）。 どこが間違っているのか教えて頂けないでしょうか？ 以下のマクロをつくるにあたって参考にしたホームページは http://officetanaka.net/excel/vba/tips/tips36.htm です Sub Sample() Call FileSearch("\\000.00.000.00\ab\c\", "ワタナベ") End Sub Sub FileSearch(Path As String, Target As String) Dim FSO As Object, Folder As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders If Folder.Name Like Target Then Debug.Print Folder.Path End If Next Folder End Sub
- ベストアンサー
- Excel（エクセル）
- テキストファイルをエクセルに移すマクロのことで？
以前、複数のテキストファイルをエクセルに移すマクロを教えてもらったのですが、 以下マクロですと、フォルダのパスを指定しないといけません。 今回教えてもらいたいのは、フォルダのパスを指定しなくてもよい方法です。 どういう事かと言うと、仮にディスクトップにフォルダがあるとします。 そのフォルダの中には、マクロが入っているエクセルシートとテキストが入っているフォルダです。 つまり、そのフォルダ内だけで、処理をしたいと考えています。 また、フォルダ名は、その時によって異なります。 今までは、以下の方法を使っていたのですが、ちょっと使いにくいと感じています。 申し訳ありませんが、どなたか教えていただけないでしょうか？ Sub Macro() Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim FolderPath As String 'ここのアドレスをファイルが格納されているフォルダのパスに変えてください FolderPath = "C:\Users\・・・" Dim myFile As Object Dim i As Long i = 2 Dim myFolder As Object For Each myFolder In fso.GetFolder(FolderPath).SubFolders For Each myFile In fso.GetFolder(myFolder).Files Cells(i, 4).Value = myFolder Cells(i, 1).Value = myFile.Name Cells(i, 7).Value = fso.OpenTextFile(myFile.Path).ReadAll() i = i + 1 Next Next End Sub Private Sub CommandButton1_Click() End Sub
- ベストアンサー
- オフィス系ソフト
- マクロ 任意の・・・を特定のシートへコピーする
いつも回答して頂きありがとうございます。 質問内容ですが・・・ (1)任意のブックを開ける。今回は『C:\Users\Owner\Documents\作業管理.xlsm』 ※本当のファイル名は『作業管理２０１３年８月』みたいなものになる ９月なら『作業管理２０１３年９月』 (2)任意のシートをコピーする。今回は『１』 ※数字の意味は日付。 ですが、今日の日付＝シート名になるとは限らない。ですので、任意で選択したい。 (3)特定のシートへ貼り付ける。 dim ws1 as object set ws1 = activesheet (4)・・・ という順序のマクロを考えていますが、任意のブックを開けて、任意のシートをコピーするという箇所の記述が分かりません。どのような記述方法があるのか教えて頂けないでしょうか？ 宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- 新しく開いたブックをアクティブにするマクロ
マクロ 新しく作ったブックをアクティブにする マクロ初心者です。 マクロを使って同階層にあるファイルのアクティブのシートを ひとつのブックにコピーして保存するマクロを作りたいと思ってます。 他の質問を参照して下記のコードを途中まで作成しました。 参照した質問では、 マクロの入っているブックにシートをコピーするようでしたが、 そうすると保存した時にマクロも保存されてしまうので 私なりに調べて、新しいブックにシートコピーするようにしましたが、 この記述の後、新しいブックをアクティブにする記述がわからず、 保存できなくなってしまいました。 ここまで終わるとマクロの入っているブックがアクティブになって終わります。 このあと新しく開いたブックをアクティブにして、 ブックのsheet1～3を削除して、名前をつけて保存したいのですが 開いたブックをアクティブにするマクロをご伝授ください。 あたらしくブックをつくるとbook1～・・・と名前が変わってしまうので 変数で名づけたいのですが、やり方が良くわかりませんのでよろしくお願いします。 何卒よろしくお願いします。 Sub consolid_test() Dim shCnt As Integer Dim Wb As Workbook Dim i As Integer Dim sh As Worksheet Dim nSh As Worksheet Dim fName As String Dim ka As String Application.ScreenUpdating = False '画面更新を一時停止 Application.DisplayAlerts = False Set mb = Workbooks.Add '新しいコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fName = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fName = Empty '全て検索 If fName <> mb.Name Then 'ブック名がこのブックの名前でなければ Set Wb = Workbooks.Open(myfdr & "\" & fName) 'そのブックを開きwbとする。 Wb.ActiveSheet.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く ActiveSheet.Name = Range("B16") 'シート名の変更 ActiveSheet.Unprotect 'シート全体をコピーして値にする Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Wb.Close (False) '保存の有無を聞かずに保存しないで閉じる N = N + 1 'ブック数をカウント End If fName = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す ・ ・ ・ ・
- ベストアンサー
- Visual Basic
- フォルダ内の特定ブックだけを1つのブックにまとめる
以前こちらで質問させて頂きましたフォルダ内の特定ブックだけを1にのブックにまとめる方法で、大変助かっていましたがブック名が変更になり、教えて頂いたマクロでは実行できなくなったので自分なりに考えたのですがどうしてもできません。 質問時のブック名は「1_****」と「2_****」で 今回「1_****」だけが「1(3)_****」に変更になりました。 下記のマクロでmyfile = dir(mypath & "1_" & "*.xl*")→myfile = dir(mypath & "1(3)_" & "*.xl*")に変更するのはわかるのですが do until myfile = "" myfile2 = "2" & mid(myfile,2,99)をどう変更すれば良いかわかりません どなたかお助け頂けませんか？ sub macro1() dim myPath as string dim myFile as string dim myFile2 as string mypath = "c:\test\" myfile = dir(mypath & "1_" & "*.xl*") do until myfile = "" myfile2 = "2" & mid(myfile,2,99) workbooks.open mypath & myfile workbooks.open mypath & myfile2 application.displayalerts = false workbooks(myfile).worksheets("2").delete application.displayalerts = true workbooks(myfile2).worksheets("2").move after:=workbooks(myfile).worksheets("1") workbooks(myfile).close true workbooks(myfile2).close false myfile = dir() loop end sub
- 締切済み
- オフィス系ソフト
- エクセルのマクロで特定フォルダ内のJPGファイルを検索して開きたいので
エクセルのマクロで特定フォルダ内のJPGファイルを検索して開きたいのですが、うまくいきません。 検索して開くファイルは、アクティブセルの値で始まります。 （例えばアクティブセルが「0000」だとすると、フォルダ内にある「0000りんご.JPG」というファイルを開く。りんごの部分は特定の文字でないためワイルドカードを使用してみましたがうまくいきません） Sub test() Dim P As String Dim Fname As String Fname = ActiveCell.Value P = "パス名\" & Fname & "*.JPG" Shell "Rundll32.exe" & " Shimgvw.dll,ImageView_Fullscreen" & " " & P, vbNormalFocus End Sub どうぞよろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- エクセルマクロでフォルダのコピーがしたい
こんにちわ 色々調べてフォルダのコピーはできたのですが、色々いじっていて分からないことが出てきたので質問に来ました。 やりたいことはフォルダをコピーしたいのですが、それぞれ名前を自動で変えようと思い下記(1)を元に下記(2)を作ってみましたが、動きませんでした。 (1)いくつかのサイトを見て動いたマクロ sub test() Dim myFSO As New FileSystemObject myFSO.CopyFolder "C:\test", "C:\test2" End Sub (2)ちょっといじって動かないマクロ sub test() Dim myFSO As New FileSystemObject Dim name As String Dim name2 As String name = "C:\test" name2 = "C:\test2" myFSO.CopyFolder "name", "name2" End Sub 「パスが見つかりません」と出てきたので、読み込んでいないのだとは思うのですが、どうしたら動くかアドバイスをいただきたいです。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- 大至急！ 一連のマクロが止まってしまいました。対処法をおしえてください。
シーケンサから送られてくるデータがあり、 それを24時間モニターするシステムをexcel2007で構築しています。 詳細 ・excelとシーケンサは1秒ごとに通信している ・1ブックに7シート（うち5シートがグラフ） ・一日三つのブックを保存します。 ・ひとつのファイルが約400KB程あり、 一日で諸々含め約1.5Mほどになります。 ・excel自体には、タイマーで自動起動するマクロが （印刷、保存1、保存2、保存フォルダ作成、画面クリア、 次回タイマー予約）とあります。 ・PCスペックは core2duo 500GB メモリ2GB 上記システムが、約三カ月稼働後の印刷を最後に、タイマーマクロが働かなくなり、再起動後、20日で再び同じ症状になりました。 二度とも、保存１の段階（もしくは印刷終了後）でストップしています。 一度目には、保存フォルダに0kbのファイルを確認しました。 （つまりは、保存に失敗しているってことでしょうか？） ちなみに、ストップしたのは、マクロのプログラムで、 EXCEL自体の表示はモニターをし続けていました。 ただ、そこから終了をかけても落ちない状態でした。 保存作業で引っかかり、それが尾を引いて他の作業が出来なくなった、と考えるべきでしょうか？ 実際、その現場に自分も居合わせてはおらず、その時の状況（CPU稼働率、メモリの状況など）が不明確で、大変申し訳ありませんが、 それらの対処法があれば教えてください。 一応、保存コードも記載しておきます。 Option Explicit Sub DB保存() On Error Resume Next Dim bn As String Dim 値 As String Dim 本日 As String Dim 新ブック As String Dim 年 As String Dim 月 As String Dim 日 As String Dim 時間 As String bn = "予冷庫 温湿度管理表.xlsm" 年 = Year(Now) 月 = Month(Now) 日 = Day(Now) 時間 = 235400 '変更注意 本日 = Format(expression:=Date, Format:="yyyymmdd") 値 = (本日) & (時間) 新ブック = "C:\xxx\管理者用\DB\DB" & (値) & ".xlsm" 'パス変更注意 Workbooks(bn).SaveCopyAs Filename:=新ブック End Sub
- ベストアンサー
- Visual Basic
お礼
回答頂きまして、ありがとうございます＾＾ お礼、返答遅れまして申し訳ございません＾＾； いただきました、コードを当方のデータで使わせてもらったのですが 当方の技量、知識不足によるところが大きいと思われますが いろいろ試してみたのですが、なぜかうまくいきませんでした＾＾； 自分自身のスキルアップの必要性を痛切に感じました＾＾； せっかく作成していただいたのですが、生かすことが出来ずもうしわけございません。