| |
▼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
>
>サブフォルダもということなら、いろいろ方法はありますが、わりとポピュラーな
>ＦＳＯの例です。（最初にアップした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
|
|
ぴょんきち
- 11/4/6(水) 16:05 -
