Excel VBA質問箱 IV

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

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


2325 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【68545】指定フォルダ内のファイルの読み込み
質問  ぴょんきち  - 11/3/22(火) 16:51 -

引用なし
パスワード
   困っています。

フォルダを指定して、その中にあるファイルのデータを読み込んで
新規ファイルに一覧表にしたいのですが、わかりません。

たとえば、Aというフォルダの中に10個のファイルがあります。
その中にあるすべてのファイルの”A1”と”C1”のデーターを抜き出して
新規ファイルに一覧表にして書き出したいのです。

私のレベルでは、記録マクロを作るくらいしかできないので
どなたか、教えてください。
お願いします。

【68546】Re:指定フォルダ内のファイルの読み込み
回答  UO3  - 11/3/22(火) 17:53 -

引用なし
パスワード
   ▼ぴょんきち さん:

こんにちは

とりあえず、フォルダを指定して、そのフォルダ内のファイルを抽出する部品を2種類。
サブフォルダは対称にしていません。必要なら可能ですけど。
取り出したファイルをシートに編集する部分はおできになりますね。

Sub Sample1()
  Dim myPath As String
  Dim myFile As String
  myPath = Get_Folder
  If myPath = "" Then Exit Sub
  myFile = Dir(myPath & "\")
  Do While myFile <> ""
    MsgBox myFile
    'ここでシートにファイル名を追加編集
    myFile = Dir()
  Loop
End Sub

Sub Sample2()
  Dim myPath As String
  Dim myFile As Object
  Dim myFso As Object
  myPath = Get_Folder
  If myPath = "" Then Exit Sub
  
  Set myFso = CreateObject("Scripting.FileSystemObject")
  
  For Each myFile In myFso.getfolder(myPath).Files
    MsgBox myFile.Name
    'ここでシートにファイル名を追加編集
  Next
  
  Set myFso = Nothing
  
End Sub

Private Function Get_Folder() As String
Dim ffff
Dim WSH As Object

  Set WSH = CreateObject("Shell.Application")
  Set ffff = WSH.BrowseForFolder(&O0, "フォルダを選択してください", &H1 + &H10)
  If ffff Is Nothing Then
    Get_Folder = ""
  Else
    Get_Folder = ffff.Items.Item.Path
  End If

End Function

【68547】Re:指定フォルダ内のファイルの読み込み
お礼  ぴょんきち  - 11/3/22(火) 20:23 -

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

早速の書き込みありがとうございます。
アドバイス頂きました内容については、正直ほとんど
分からない状態です。(^^;

動きを見ながら、記述されている内容を分析してみます。

>とりあえず、フォルダを指定して、そのフォルダ内のファイルを抽出する部品を2種類。
>サブフォルダは対称にしていません。必要なら可能ですけど。
>取り出したファイルをシートに編集する部分はおできになりますね。

上記のレベルですので、シートに編集する部分も
わからない状態です。

教えて頂き有難う御座いました。

【68548】Re:指定フォルダ内のファイルの読み込み
回答  UO3  - 11/3/23(水) 11:33 -

引用なし
パスワード
   ▼ぴょんきち さん:

まずは、アップしたコードをそのまま貼付け、Sample1あるいはSample2を実行して
感覚を把握してください。

で、以下は、Sample1をベースに、ファイル名を一覧にしています。
実際には、表示したい項目も様々あるんだろうと思いますが、まずはツカミとして。


Sub Sample1()
  Dim myPath As String
  Dim myFile As String
  Dim c As Range
  
  myPath = Get_Folder
  If myPath = "" Then Exit Sub
  
  Application.ScreenUpdating = False
  
  With Sheets("Sheet1")  '<== 編集シート 実際のシート名に
    .Cells.ClearContents
    .Range("A1").Value = "ファイル名"
    Set c = .Range("A2") '編集開始位置
    
    myFile = Dir(myPath & "\")
    Do While myFile <> ""
      c.Value = myFile
      Set c = c.Offset(1)
      myFile = Dir()
    Loop
    
    .Columns("A").AutoFit
    
  End With
  
  Set c = Nothing
  Application.ScreenUpdating = True
  
End Sub

【68549】Re:指定フォルダ内のファイルの読み込み
回答  UO3  - 11/3/23(水) 11:57 -

引用なし
パスワード
   ▼ぴょんきち さん:

【新規ファイルに】というところを読み飛ばしていました。
ついでに、フォルダ取得のサブプロシジャ、すこし手抜きのコードでしたので
ちょっと直してあります。

Option Explicit

Sub Sample1()
  Dim myPath As String
  Dim myFile As String
  Dim c As Range
 
  myPath = Get_Folder
  If myPath = "" Then Exit Sub
 
  Application.ScreenUpdating = False
  
  Workbooks.Add
  Cells.ClearContents
  Range("A1").Value = "ファイル名"
  Set c = Range("A2") '編集開始位置

  myFile = Dir(myPath & "\")
  Do While myFile <> ""
    c.Value = myFile
    Set c = c.Offset(1)
    myFile = Dir()
  Loop
  
  Columns("A").AutoFit
 
  Set c = Nothing
  Application.ScreenUpdating = True
 
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

【68550】Re:指定フォルダ内のファイルの読み込み
質問  ぴょんきち  - 11/3/23(水) 14:44 -

引用なし
パスワード
   ご回答ありがとうございます。

実際にマクロを貼り付けて動きを確認しました。
各命令の意味を解読しています。

フォルダの中の”ファイル名”を取り込んで
表示するのは、こんな短いマクロでできるんですね。

ちなみに、ファイル名を利用してそのファイルを開くのには
下記でよいでしょうか?

Workbooks.Open Filename:=myFile

上記を前に教えていただいたDo行の下に入れるとよいのでしょうか?


  myFile = Dir(myPath & "\")
  Do While myFile <> ""


    c.Value = myFile
    Set c = c.Offset(1)
    myFile = Dir()
  Loop

【68551】Re:指定フォルダ内のファイルの読み込み
回答  UO3  - 11/3/23(水) 17:01 -

引用なし
パスワード
   ▼ぴょんきち さん:

Dir関数で取得したmyFileはブック名のみ(ブック名.xls)です。
実際に開くときには、パス情報が必要ですので

Workbooks.Open Filename:=myPath & "\" & myFile

ということになります。

場所はDo/Loopの間のどこでもよろしいのですが、
実際にブックを開いて、そこから何か情報を取り出し、一覧表に反映させるということですか?

【68552】Re:指定フォルダ内のファイルの読み込み
お礼  ぴょんきち  - 11/3/23(水) 20:12 -

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

>Dir関数で取得したmyFileはブック名のみ(ブック名.xls)です。
>実際に開くときには、パス情報が必要ですので
>
>Workbooks.Open Filename:=myPath & "\" & myFile
>
>ということになります。

こういう記述をするんですね。


>場所はDo/Loopの間のどこでもよろしいのですが、
>実際にブックを開いて、そこから何か情報を取り出し、一覧表に反映させるということですか?

そうです。ブックの特定セル、たとえば"A1"と"C1"のセルを
コピーして、一覧表に貼り付けたいのです。
フォルダ内の全ブックについてです。

早速、試してみます。ありがとうございます。

【68553】Re:指定フォルダ内のファイルの読み込み
回答  UO3  - 11/3/24(木) 10:00 -

引用なし
パスワード
   ▼ぴょんきち さん:

おはようございます。

ご参考までに、新規ブックのA列にブック名、B列に抽出ブックのA1の値、B列に抽出ブックのC1の値を
セットするコードを2つ。

Sample1Aは実際にブックを開いて参照します。
参照するシートは開いたブックの一番左にあるシートとしています。

Sample1Bはブックを開かずにセルの値を転記します。
ただし、シート名がわかっていることが前提。サンプルでは"Sheet1"としています。

Option Explicit

Sub Sample1A()
  Dim myPath As String
  Dim myFile As String
  Dim c As Range

  myPath = Get_Folder
  If myPath = "" Then Exit Sub

  Application.ScreenUpdating = False
 
  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
      Workbooks.Open myPath & "\" & myFile
      c.Offset(, 1).Value = Worksheets(1).Range("A1").Value
      c.Offset(, 2).Value = Worksheets(1).Range("C1").Value
      ActiveWorkbook.Close savechanges:=False
      Set c = c.Offset(1)
    End If
    myFile = Dir()
  Loop
 
  Columns("A:C").AutoFit

  Set c = Nothing
  Application.ScreenUpdating = True

End Sub

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

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

【68597】Re:指定フォルダ内のファイルの読み込み
お礼  ぴょんきち  - 11/3/28(月) 19:50 -

引用なし
パスワード
   こんばんは。

U03さんのプログラムを参考にところどころ
を変更して動かしながら何が変わるかを見て
自分がやりたいマクロに変更できました。
有難うございました。

あとは、サブディレクトリも見れるようにできれば
私の欲しかったマクロになります。

宜しければ、サブディレクトリを見に行く
方法も教えて頂けませんでしょうか?

よろしくお願いいたします。

【68609】Re:指定フォルダ内のファイルの読み込み
回答  UO3  - 11/3/29(火) 10:11 -

引用なし
パスワード
   ▼ぴょんきち さん:

こんにちは

サブフォルダもということなら、いろいろ方法はありますが、わりとポピュラーな
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

【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

【68686】Re:指定フォルダ内のファイルの読み込み
回答  UO3  - 11/4/6(水) 18:00 -

引用なし
パスワード
   ▼ぴょんきち さん:

Sample4としてアップしますね。

(GetBooksプロシジャも、ちょっと直してあります)

Option Explicit

Sub Sample4()
  Dim myPath As String
  Dim myFso As Object
  Dim myPool As Collection
  Dim myFold As Object
  Dim myData As Variant
  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
  Range("A1:C1").Value = Array("ファイル名", "A1", "C1")
  Set c = Range("A2") '編集開始位置

  Set myFso = CreateObject("Scripting.FileSystemObject")
  Set myFold = myFso.getfolder(myPath)
  Set myPool = New Collection
 
  Call getBooks(myFold, myPool) '中でサブフォルダ内も再帰で検索
 
  For Each myData In myPool
    
    c.Value = myData(0)
    linkStr = "='" & myData(1) & "\[" & myData(0) & "]" & 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)
  Next

  Set myFso = Nothing
  Set myFold = Nothing
  Set myPool = Nothing
  Set c = Nothing
  
  Application.ScreenUpdating = True
  
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.ParentFolder)
    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

【68688】Re:指定フォルダ内のファイルの読み込み
発言  kanabun  - 11/4/7(木) 0:26 -

引用なし
パスワード
   ▼ぴょんきち さん:
▼UO3 さん:
ちょっとおじゃまします。
>
>それに、今回のサブフォルダを見に行ってというところで、躓いております。

別法ですが、サブフォルダを含む指定拡張子のファイルの取得は
Dirコマンドを使うと再帰せずに一覧を得ることができます。

各Bookの参照するシート名は 「Sheet1」のように固定されていることが
リンク式埋め込み方式のポイントですね

Sub Try1()
' ------- 検索フォルダの指定
  Dim objFolder As Object
  Const BIF_RETURNNONLYFSDIRS = &H1 'ディレクトリのみ選択可
  Const BIF_EDITBOX = &H10 'アイテム名入力用のEdit_boxを表示
  Dim hWnd As Long
  Dim sPath As String
  hWnd = Application.hWnd
  Set objFolder = _
    CreateObject("Shell.Application").BrowseForFolder( _
         hWnd, _
         "フォルダを選択して下さい", _
         BIF_RETURNNONLYFSDIRS Or BIF_EDITBOX)
  If (objFolder Is Nothing) Then Exit Sub
  
  sPath = objFolder.Self.Path & "\"
 
' ------- サブディレクトリを含む *.xlsファイルの検索
  Dim fList
  Dim i As Long
  Dim n As Long
  Dim tmpPath As String
  Dim sCmd As String
  Dim ko As Long
  
  tmpPath = Environ$("Temp") & "\Dir.tmp"
  sCmd = "DIR """ & sPath & "*.xls" & """ /b /s > """ & tmpPath & """"
  With CreateObject("WScript.Shell")
    ko = .Run("CMD /C " & sCmd, 7, True) 'Dirコマンド実行
  End With
  Dim io As Integer
  Dim buf() As Byte
  io = FreeFile()
  Open tmpPath For Binary As io
   ReDim buf(1 To LOF(io))
   Get #io, , buf
  Close io
  Kill tmpPath
  fList = Split(StrConv(buf, vbUnicode), vbCrLf) 'ファイルリストを得る
  
' ------- リンク式表の作成
  n = UBound(fList)
  Dim RefTable()
  ReDim RefTable(n, 1 To 3)
  RefTable(0, 1) = "ファイルパス"
  RefTable(0, 2) = "A1値"
  RefTable(0, 3) = "C1値"
  For i = 0 To n - 1
    RefTable(i + 1, 1) = fList(i)
    ko = InStrRev(fList(i), "\")
    sCmd = "='" & Left$(fList(i), ko) & _
        "[" & Mid$(fList(i), ko + 1) & "]Sheet1'!"
    RefTable(i + 1, 2) = sCmd & "A1"
    RefTable(i + 1, 3) = sCmd & "C1"
  Next
' ------- リンク式表を新規シートに貼り付ける
  Workbooks.Add(xlWBATWorksheet).Worksheets(1) _
    .Cells(1).Resize(n, 3).Value = RefTable
End Sub

【68691】Re:指定フォルダ内のファイルの読み込み
発言  UO3  - 11/4/7(木) 6:33 -

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

ありがとうございます。
私の手元に、フォルダからのファイルの取得のサンプルコードをまとめたものを
リファレンスとして作成しているものがあります。
いろんな板でkanabunさんはじめ、皆さんに教えてもらったものを咀嚼し理解できたものを
まとめているものですが、以前からたびたび教えていただいているdirコマンドによるものも
それに加えたいと思っていまして、ただ、実際には使ったことがないものでして
目下、鋭意、勉強中です。
近いうちに私のリファレンスに加えることができるよう精進します。

【68692】Re:指定フォルダ内のファイルの読み込み
発言  kanabun  - 11/4/7(木) 9:14 -

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

> 以前からたびたび教えていただいているdirコマンドによるものも
> それに加えたいと思っていまして

「教える」なんてとんでもないです。再帰しないでサブディレクトリが
検索できるので、 FieSearch代替として最近よく使ってますが、この方法
何を隠そう、ここの目安箱でちゃっぴさんが書かれていたものなんですよ(^^。
ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=74;id=FAQ

▼ぴょんきち さん:
Dirコマンドの豊富なオプションはあちこちに解説がありますが、
私的には ここを参照しています。
ht tp://www2.nsknet.or.jp/~azuma/md/dir.htm

上の例では /b /s という2つのオプションを使ってますが、

/b :ファイル名のみを表示する。
   (ファイルサイズやタイムスタンプを省略する。)
/s : サブディレクトリも含め検索する。

という意味になります。

【68723】Re:指定フォルダ内のファイルの読み込み
お礼  ぴょんきち  - 11/4/10(日) 17:17 -

引用なし
パスワード
   ▼UO3 さん:
>Sample4としてアップしますね。
>
>(GetBooksプロシジャも、ちょっと直してあります)

いつもすみません。ありがとうございます。
教えていただいている内容を、動作させながら理解しています。(なんとなく・・)

ひとつひとつの命令を理解するには、先が長いです。

【68724】Re:指定フォルダ内のファイルの読み込み
お礼  ぴょんきち  - 11/4/10(日) 17:23 -

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

>▼ぴょんきち さん:
>Dirコマンドの豊富なオプションはあちこちに解説がありますが、
>私的には ここを参照しています。
>ht tp://www2.nsknet.or.jp/~azuma/md/dir.htm
>
>上の例では /b /s という2つのオプションを使ってますが、
>
> /b :ファイル名のみを表示する。
>   (ファイルサイズやタイムスタンプを省略する。)
> /s : サブディレクトリも含め検索する。
>
>という意味になります。

色々なやり方が、あるものなんですね。
kanabun さんから教えていただいたプログラムも
動作させてみたいと思います。

正直、皆さんのコメントについていけていない自分ですので
上記のように、説明を頂けると、実際に動作をさせて、
『ああ、こうなるのか』と頭でなく体でわかる(?)ので助かります。

またの質問の時もお願い致します。
有難うございました。

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