EXCEL VBAでフォルダ容量の測定
- EXCEL VBAを使用してフォルダの容量を自動で測定するツールを作成中です。
- 具体的には、１枚目のシートのセルにあらかじめ測定対象となるフォルダのパスを記述し、そのパスをもとに２枚目のシートに測定した容量を出力したいと考えています。
- しかし、FSO.GetFolder("Path").Size の"Path"の部分に対象フォルダのパスを反映させる方法が分かりません。
- ベストアンサー
EXCEL VBAでフォルダ容量の測定
お世話になります． EXCELでフォルダの容量を自動で測量するツールを作成中です． 大まかな概要としては，１枚目のシートのセルにあらかじめ測定対象となるフォルダのパスを記述しておき， そのパスをもとに２枚目のシートに測定した容量を出力したいと考えています． 作成中のソースから抜粋させて頂きますが，以下の部分が上手くいきません． ＜＜作成中のソース＞＞ Sub FolderSize_Count() Dim FSO As Variant Set FSO = CreateObject("Scripting.FileSystemObject") Dim Path As String With Sheets("Sheet2") Path = Application.Worksheets("sheet1").Range("A1").Value .Cells(1, 1) = FSO.GetFolder("Path").Size End With End Sub ＜＜不明点＞＞ FSO.GetFolder("Path").Size の"Path"の部分には対象フォルダのパスを記述する必要があるが， 別シートから取得した値を" "に反映させる記述が分かりません． ちなみに Application.Worksheets("sheet1").Range("A1").Valueにて，対象フォルダのパスを取得出来ていることと， FSO.GetFolder("C:\test").Sizeにて，Cドライブ直下のtestフォルダの容量を取得できることは確認済みです． お手数お掛けいたしますが，有識者の方，ご教授頂ければ幸いです． 以上，よろしくお願いいたします．
- boo111
- お礼率50% (2/4)
- Visual Basic
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
Pathが変数なら『"』でくくってしまってはいけません .Cell(1,1) = FSO.GetFolder(Path).Size といった具合にします 『"』でくくってしまうと カレントフォルダにある.\Pathを探します
関連するQ&A
- ファイルサイズを書き込めません。
過去ログを検索したのですが載っていなかったので質問させて頂きます。 指定したフォルダ毎の容量を管理したいと考え,ネットで拾った以下のソースをEXCELで動かしましたが「書き込みできません」というエラーと共に書き込めませんでした。 Sub FolderSize_Count() Dim FSO As Variant Set FSO = CreateObject("Scripting.FileSystemObject") Dim Path As String With Sheets("Sheet2") Path = Application.Worksheets("sheet1").Range("A1").Value Sheet2.Cells(1, 1) = FSO.GetFolder(Path).Size End With End Sub 書き込めませんというキーワードで検索をGOOGLEでもかけたのですが見つからずに困っています。 もしよろしければご回答お願い致します。
- ベストアンサー
- Visual Basic
- 複数のエクセルブックを開かず特定シートのセル抽出
他の方の質問を参考に自作しましたが動作に時間が掛かる為、教えて下さい。 PCはWin10、エクセル2016、ファイル形式はxlsm 該当フォルダはネットワーク上\\○○○○\Users\ この中に複数ブックが存在 抽出したいデータは全てのブックの「メニュー」というSheetのA100からAO100までを 「集計.xlsm]のSheet1の２行目から抽出結果をA２からAO2までを２行目、３行目とずらして値で貼り付けたい 作成したVBAを見て良い方法をご教授下さい。 Sub 集約() Dim myFolder As Variant Dim fso As Object Dim GetFolder As Object Dim Fol As Object Set fso = CreateObject("Scripting.FileSystemObject") With Application.FileDialog(msoFileDialogFolderPicker) If .Show <> 0 Then myFolder = .SelectedItems(1) End If End With With CreateObject("WScript.Shell") .CurrentDirectory = myFolder End With Set GetFolder = fso.GetFolder(myFolder) For Each Fol In GetFolder.SubFolders Debug.Print Fol.Name Next Set GetFolder = Nothing 'フォルダの場所を変数に入れる Dim Folder_path As String Folder_path = Range("a1").Value '集計先のシートを指定し、変数に入れる Dim w Set w = Worksheets("sheet1") '集計するブックを変数に入れる Dim Merge_book As String Merge_book = Dir(Folder_path & "\*.xlsm*") 'いったん数値をクリア w.Range("b" & Rows.Count).Clear '集計先のシートの1行からスタート Dim n n = 4 '指定したフォルダから、Excelファイルを探す Do Until Merge_book = "" Workbooks.Open FileName:=Folder_path & "\" & Merge_book '見つかったら、A列にファイル名、B列に集計値を入れる w.Range("a" & n).Value = Merge_book w.Range("b" & n).Value = Workbooks(Merge_book).Worksheets("メニュー").Range("a100").Value w.Range("c" & n).Value = Workbooks(Merge_book).Worksheets("メニュー").Range("b100").Value w.Range("d" & n).Value = Workbooks(Merge_book).Worksheets("メニュー").Range("c100").Value ・・・・・・・・・・・・・・・省略・・・・・・・・・・・・・ ・ ("ao100").Value w.Range("ap" & n).Value = Workbooks(Merge_book).Worksheets("メニュー").Range '次の行へ n = n + 1 '集計するブックを閉じる Workbooks(Merge_book).Close '次のファイルを探しに行く Merge_book = Dir() Loop End Sub この方法は１つのフォルダ直下に全てのブックを入れないと動かないのでPCの容量に負担が掛かり画面もチラチラし、時間も掛かる為、もっと効率的な方法で作業を行いたいのです。 よろしくお願いいたします。
- ベストアンサー
- Windows 10
- VBAでアクティブなファイルを参照して、ファイル一覧作成（サブフォルダ含む）
VBAでアクティブなファイルのフォルダ（サブフォルダを含む）のファイル一覧を 作成したいと思っています。 以下のサイトを参考にして、パス、ファイル名を落とすまではできました。 http://okwave.jp/qa3544575.html === Sub test() Application.ScreenUpdating = False Sheet1.Cells.Clear Sheet1.Cells(1, 1) = "パス" Sheet1.Cells(1, 2) = "ファイル名" files "d:\", 2 Application.ScreenUpdating = True End Sub Sub files(path As String, ByRef row As Long) DoEvents Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim f As Object For Each f In fso.GetFolder(path).files Sheet1.Cells(row, 1) = path Sheet1.Cells(row, 2) = f.Name row = row + 1 Next For Each f In fso.GetFolder(path).SubFolders files f.path, row Next Set fso = Nothing End Sub === >files "d:\" の箇所を修正して、アクティブなブックを参照しようとしてみたのですが、 なかなか上手くいきません。 また、できれば *.xls などファイルの種類を指定したいのです。 filesearchを使用して組んだ時は 「AAA = ActiveWorkbook.path」「Filetype ～ 」 などでそれらの指定ができたのですが、上記に応用する事ができません。 どなたかご教示頂けますよう、よろしくお願いいたしますm(_ _)m
- ベストアンサー
- オフィス系ソフト
- vbaでフォルダ属性がうまく取れません
vbaでフォルダ属性が隠しフォルダかどうかを調べるコードを書いています。 C:\ProgramData\ は隠しフォルダなのに、なぜか16が返って来ます。 試しにvbs(wsh)だと18が返って来ます。 環境は Win10 + Excel2013(32ビット) です。 vbaで返値18を求めるにはどうすれば良いのでしょうか。 Sub test() Dim mPath Dim fso, f mPath = "C:\ProgramData\" Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder(mPath) MsgBox f.Attributes End Sub
- ベストアンサー
- Visual Basic
- VBA：2つのCSVファイルを開きたいです。
エクセル2010のVBAにてCSVファイルを開き結合させるプログラムを組もうとしているのですが、2つ目のCSVファイルを開こうとすると、何故かエラーが出てしまいます。 -------------------------------------------------------------------------------- 1つ目 Sub mobile_FileSearch(Path As String) 'test.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call mobile_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "test.csv" Then Workbooks.Open ("test.csv") End If Next File End Sub ---------------------------------------------------------------------------- 2つ目 Sub local_FileSearch(Path As String) 'bbb.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call local_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "bbb.csv" Then Workbooks.Open ("bbb.csv")'←ここでエラー End If Next File End Sub ------------------------------------------------------------------------ まったく同じプログラムで、csvファイル名だけ変えただけで実行時エラー1004が出てしまいます。 一体全体何が問題なのでしょうか？
- ベストアンサー
- その他（プログラミング・開発）
- ＥＸＣＥＬ ＶＢＡについて（再質問）
お世話になります。 EXCEL VBAで指定したフォルダのEXCELブックが１つでもオープンされているかどうか知りたいのですが、可能でしょうか。 という質問を行い、以下の回答をいただきました。 自分でテストしてみてできたと思ったのですが、 他の人が開いているのが分かりませんでした。 他の人がオープンしているかどうか知ることは可能でしょうか？ よろしくお願いします。 以下の回答といただきました。 －－－－－－－－－－－－－ ※[ツール]-[参照設定]で Microsoft Scripting Runtimeにチェック入れて下さい。 Dim Fso As New FileSystemObject 'ファイルシステムオブジェクト Dim xlBook As Workbook '開かれているブック Dim objFolder As Folder '調べるフォルダ Dim bOpenedBook As Boolean '開かれているかフラグ '調べるフォルダを「C:\tmp」とする。 Set objFolder = Fso.GetFolder("C:\tmp") bOpenedBook = False '今開かれているブックでループする。 For Each xlBook In Excel.Workbooks If Len(xlBook.Path) > 0 Then 'ブックが保存されているフォルダと調べるフォルダが一致するか？ If objFolder Is Fso.GetFolder(xlBook.Path) Then '一致すれば開かれている bOpenedBook = True Exit For End If End If Next '結果をメッセージボックスで表示 If bOpenedBook Then MsgBox "開かれています。" Else MsgBox "一つも開かれていません。" End If
- ベストアンサー
- Visual Basic
- FileSystemObjectでのパス名の取得
お世話になります。 VBScriptでフォルダ内のファイルコピーのスクリプトを作っているのですが、FileSystemObjectを使用してネットワーク共有してある日本語のフォルダ名（Getfolder）を取得すると文字化けして取得できません。 Dim fso,fo set fso = CreateObject("Scripting.FileSystemObject") set fo = fso.getfolder(フォルダパス) WScript.Echo fo.path <---フォルダのパスを表示 なにか解決する方法はありますでしょうか？ ちなみに、ローカルドライブの日本語フォルダは正常に取得できました。
- 締切済み
- Visual Basic
- エクセルで複数のフォルダ内のファイルのパスと作成日
いつもお世話になっております。 だいぶ前にここで表題の質問に対し下記の回答をもらって使っていたのですが、当初はうまく動いているはず（と思った？）ですが、今回明らかにかなりの抜けが有ることが分かりました。A~Zまでのフォルダで抜けているフォルダがいくつもあります。 また、出力の順番が品名フォルダのN、Yから始まって、50音、アルファベット（A、B・・）と順不同。 また、数字で始まる品名のフォルダは無視されているようです。 かなりの確率で抽出されているようなのですが、当方にはどこが悪いのか全く分かりようがないのでHELPさせていただきます。 尚、対象となるファイルが保存されているフォルダー構成は 下記のように・・・・と長いファイルパスの最後に「1.試験成績表」というフォルダに入っている、エクセル、pdf、ワードファイルで、知りたい情報は、当該ファイルのフルパスと作成日です。 Option Explicit Const tgDir = "\\Srv01\部署名\・・・\担当者名\成績書" Const PicDir = "1.試験成績表" Sub Sample() Call setFileList(tgDir) End Sub '//-------------------- Sub setFileList(searchPath) Dim startCell As Range Dim maxRow As Long Dim maxCol As Long Set startCell = Cells(5, 2) 'このセルから出力し始める startCell.Select 'シートをいったんクリア maxRow = startCell.SpecialCells(xlLastCell).Row maxCol = startCell.SpecialCells(xlLastCell).Column Range(startCell, Cells(maxRow, maxCol)).ClearContents Call getFileList(searchPath) startCell.Select End Sub '//-------------------- Sub getFileList(searchPath) Dim FSO As New FileSystemObject Dim objFiles As File Dim objFolders As Folder Dim separateNum As Long 'サブフォルダ取得 For Each objFolders In FSO.GetFolder(searchPath).SubFolders Call getFileList(objFolders.Path) Next 'ファイル名の取得 For Each objFiles In FSO.GetFolder(searchPath).Files separateNum = InStrRev(objFiles.Path, "\") If Right(Left(objFiles.Path, separateNum - 1), Len(PicDir)) = PicDir Then 'セルにパスとファイル名を書き込む ActiveCell.Value = Left(objFiles.Path, separateNum - 1) ActiveCell.Offset(0, 1).Value = Right(objFiles.Path, Len(objFiles.Path) - separateNum) ActiveCell.Offset(0, 2).Value = FileDateTime(objFiles) ActiveCell.Offset(0, 3).Value = Format((FileLen(objFiles) / 1024), "#.0") ActiveCell.Offset(1, 0).Select End If Next End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルVBA フォルダ内のどんなシート名であっても読み込みたい
フォルダ内の別ブック(D3で指定)の「情報」シートを読み込んで対象年月日に該当するデータを抽出して別ブックに貼り付けるものなんですが、下のコードではSet ws = wb.Worksheets("情報")と、なっていて、限定しているのですが、これをD3のファイルのどんなシート名であっても読み込みたいのですが、どのようにコードにしたらいいでしょうか？D3で指定するブックには必ずひとつのシートしかありません。 よろしくお願いします。 Sub test_1() Dim wb As Workbook Dim ws As Worksheet Dim ms As Worksheet Dim nb As Workbook Dim r As Long Set ms = ThisWorkbook.Worksheets("メニュー") Set wb = Workbooks.Open(ms.Parent.Path & "\" & ms.Range("D3").Value) Set ws = wb.Worksheets("情報") Set nb = Workbooks.Add With ws .Range("Q1").AutoFilter _ Field:=17, _ Criteria1:=">=" & ms.Range("D5").Text, _ Operator:=xlAnd, _ Criteria2:="<=" & ms.Range("F5").Text With .AutoFilter.Range r = .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count If r = 1 Then MsgBox "抽出対象データ無し。" wb.Close False nb.Close False Set wb = Nothing: Set ws = Nothing Set ms = Nothing: Set nb = Nothing Exit Sub End If .Copy End With End With With nb.Worksheets(1) .Paste With .Range("A1:AG1") .Interior.ColorIndex = 6 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With End sub
- ベストアンサー
- オフィス系ソフト
- テキストファイルをエクセルに移すマクロのことで？
以前、複数のテキストファイルをエクセルに移すマクロを教えてもらったのですが、 以下マクロですと、フォルダのパスを指定しないといけません。 今回教えてもらいたいのは、フォルダのパスを指定しなくてもよい方法です。 どういう事かと言うと、仮にディスクトップにフォルダがあるとします。 そのフォルダの中には、マクロが入っているエクセルシートとテキストが入っているフォルダです。 つまり、そのフォルダ内だけで、処理をしたいと考えています。 また、フォルダ名は、その時によって異なります。 今までは、以下の方法を使っていたのですが、ちょっと使いにくいと感じています。 申し訳ありませんが、どなたか教えていただけないでしょうか？ 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
- ベストアンサー
- オフィス系ソフト
お礼
ご指摘通り修正し，意図通り動作しました． ありがとうございました．