| |
フォルダを指定して、ファイル名、シート名を取得。のサンプルです。
非常に似ている処理なので、参考になると思います。
フォルダの中に、xlsファイルを何個か用意してお試し下さい。
'Application.ScreenUpdating = False
のコメントを解除すると画面表示の更新が停止して
ちらつかなくなります。
Sub Sample()
Dim myObj As Object
Dim myFileName As String
Dim myDir As String
Dim mySheet As Worksheet
'Application.ScreenUpdating = False
With ThisWorkbook.ActiveSheet
Set myObj = CreateObject("Shell.Application"). _
BrowseForFolder(0, "フォルダを選択してください", 0)
If myObj Is Nothing Then Exit Sub
myDir = myObj.Items.Item.Path & "\"
myFileName = Dir(myDir & "*", vbHidden + vbSystem)
Do
Workbooks.Open myDir & myFileName
For Each mySheet In ActiveWorkbook.Worksheets
.Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = myFileName
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Value = mySheet.Name
Next mySheet
Workbooks(myFileName).Close False
myFileName = Dir()
Loop Until myFileName = vbNullString
.Range("A1").Value = "ファイル名"
.Range("B1").Value = "シート名"
.Columns("A:B").AutoFit
'Application.ScreenUpdating = True
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
