Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


13553 / 76732 ←次へ | 前へ→

【68682】Re:指定フォルダ内のファイルの読み込み
お礼  ぴょんきち  - 11/4/6(水) 16:05 -

引用なし
パスワード
   ▼UO3 さん:

こんにちは。

毎回、ご回答ありがとうございます。
教えて頂きました、マクロを自分で使えるように、変更しながら
四苦八苦しています。

前に教えていただいた、フォルダ内の各ファイルの決まったセルのデーターを
抽出して別ブックを開いて一覧表にするところまでは、自分で使いたいように
変更することができました。

それに、今回のサブフォルダを見に行ってというところで、躓いております。
サブフォルダを見に行くプログラムのどこに下記のプログラムを
挿入すれば、良いのか分からないでいます。
単純に挿入できないのでしょうか?

Sub Sample1B()
  Dim myPath As String
  Dim myFile As String
  Dim c As Range
  Dim refShn As String
  Dim linkStr As String
  
  myPath = Get_Folder
  If myPath = "" Then Exit Sub

  Application.ScreenUpdating = False
  
  refShn = "Sheet1" '参照するシート名。適宜変更。
  
  Workbooks.Add
  Cells.ClearContents
  Range("A1:C1").Value = Array("ファイル名", "A1", "C1") 'タイトル
  Set c = Range("A2") '編集開始位置

  myFile = Dir(myPath & "\*.xls") 'エクセルブックのみ抽出
  Do While myFile <> ""
    If myFile <> ThisWorkbook.Name Then '念のため
      c.Value = myFile
      linkStr = "='" & myPath & "\[" & myFile & "]" & refShn & "'!"
      c.Offset(, 1).Value = linkStr & "A1"
      c.Offset(, 2).Value = linkStr & "C1"
      c.Offset(, 1).Resize(, 2).Value = c.Offset(, 1).Resize(, 2).Value
      Set c = c.Offset(1)
    End If
    myFile = Dir()
  Loop
 
  Columns("A:C").AutoFit

  Set c = Nothing
  Application.ScreenUpdating = True

End Sub


>
>サブフォルダもということなら、いろいろ方法はありますが、わりとポピュラーな
>FSOの例です。(最初にアップしたSample2の方式)
>
>Sub Sample3()
>  Dim myPath As String
>  Dim myFso As Object
>  Dim myPool As Collection
>  Dim myFold As Object
>  Dim myData As Variant
>  
>  myPath = Get_Folder
>  If myPath = "" Then Exit Sub
> 
>  Set myFso = CreateObject("Scripting.FileSystemObject")
>  Set myFold = myFso.getfolder(myPath)
>  Set myPool = New Collection
>  
>  Call getBooks(myFold, myPool) '中でサブフォルダ内も再帰で検索
>  
>  For Each myData In myPool
>    MsgBox myData(0) & vbLf & myData(1)
>    'myData(0) ブック名
>    'myData(1) ブックのフルパス
>    'ここでシートにファイル名を追加編集
>  Next
> 
>  Set myFso = Nothing
>  Set myFold = Nothing
>  Set myPool = Nothing
>  
>End Sub
>
>Private Sub getBooks(fold As Object, myPool As Collection)
>Dim myFile As Object
>Dim myFold As Object
>  
>  For Each myFile In fold.Files
>    If StrConv(Right(myFile.Name, 4), vbLowerCase) = ".xls" And _
>      myFile.Name <> ThisWorkbook.Name Then
>    
>      myPool.Add Array(myFile.Name, myFile.Path)
>    End If
>  Next
>  
>  For Each myFold In fold.subfolders
>    Call getBooks(myFold, myPool)  '再帰によるサブフォルダ検索
>  Next
>  
>End Sub
>
>
>Private Function Get_Folder() As String
>Dim ffff As Object
>Dim WSH As Object
>
>  Set WSH = CreateObject("Shell.Application")
>  Set ffff = WSH.BrowseForFolder(&H0, "フォルダを選択してください", &H1 + &H10)
>  If ffff Is Nothing Then
>    Get_Folder = ""
>  Else
>    Get_Folder = ffff.Items.Item.Path
>  End If
> 
>  Set ffff = Nothing
>  Set WSH = Nothing
> 
>End Function

0 hits

【68545】指定フォルダ内のファイルの読み込み ぴょんきち 11/3/22(火) 16:51 質問
【68546】Re:指定フォルダ内のファイルの読み込み UO3 11/3/22(火) 17:53 回答
【68547】Re:指定フォルダ内のファイルの読み込み ぴょんきち 11/3/22(火) 20:23 お礼
【68548】Re:指定フォルダ内のファイルの読み込み UO3 11/3/23(水) 11:33 回答
【68549】Re:指定フォルダ内のファイルの読み込み UO3 11/3/23(水) 11:57 回答
【68550】Re:指定フォルダ内のファイルの読み込み ぴょんきち 11/3/23(水) 14:44 質問
【68551】Re:指定フォルダ内のファイルの読み込み UO3 11/3/23(水) 17:01 回答
【68552】Re:指定フォルダ内のファイルの読み込み ぴょんきち 11/3/23(水) 20:12 お礼
【68553】Re:指定フォルダ内のファイルの読み込み UO3 11/3/24(木) 10:00 回答
【68597】Re:指定フォルダ内のファイルの読み込み ぴょんきち 11/3/28(月) 19:50 お礼
【68609】Re:指定フォルダ内のファイルの読み込み UO3 11/3/29(火) 10:11 回答
【68682】Re:指定フォルダ内のファイルの読み込み ぴょんきち 11/4/6(水) 16:05 お礼
【68686】Re:指定フォルダ内のファイルの読み込み UO3 11/4/6(水) 18:00 回答
【68723】Re:指定フォルダ内のファイルの読み込み ぴょんきち 11/4/10(日) 17:17 お礼
【68688】Re:指定フォルダ内のファイルの読み込み kanabun 11/4/7(木) 0:26 発言
【68691】Re:指定フォルダ内のファイルの読み込み UO3 11/4/7(木) 6:33 発言
【68692】Re:指定フォルダ内のファイルの読み込み kanabun 11/4/7(木) 9:14 発言
【68724】Re:指定フォルダ内のファイルの読み込み ぴょんきち 11/4/10(日) 17:23 お礼

13553 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free