List Filename with sheet names

[nyasa15]

Hello,
Can someone help me with adding the filename that corresponds to the sheets names? The below code works well, except I need to know which filename each worksheet is tied to. - Thank you

Sub GetWorkSheetNames()

Dim wb As Workbook
Dim ws As Worksheet
Dim OpenWorkbook As Workbook
Dim wks As Worksheet
Dim directory As String
Dim myFile As String
Dim fileSpec As String
Dim i As Integer, j As Integer

' Set local objects
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)

' Add path, define file type
directory = "C:\Users\2017"
directory = directory & "\"
fileSpec = ".xls"

myFile = Dir(directory & "*" & fileSpec)
i = 1

Application.ScreenUpdating = False
Do While myFile <> ""

' Open file in hidden mode... might be faster
Set OpenWorkbook = GetObject(directory & myFile)

' Application.Workbooks.Open(Filename:=directory & myFile, ReadOnly:=True)
' List sheet names starting at A2
For j = 1 To OpenWorkbook.Sheets.Count
ws.Cells(i + 1, 1) = OpenWorkbook.Sheets(j).Name
i = i + 1
Next

OpenWorkbook.Close SaveChanges:=False
Set OpenWorkbook = Nothing
myFile = Dir
Loop
Application.ScreenUpdating = True

End Sub

[Logit]

Sub GetWorkSheetNames()

Dim wb As Workbook
Dim ws As Worksheet
Dim OpenWorkbook As Workbook
Dim wks As Worksheet
Dim directory As String
Dim myFile As String
Dim fileSpec As String
Dim i As Integer, j As Integer

' Set local objects
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)

' Add path, define file type
directory = "C:\Users\My\Desktop"
directory = directory & "\"
fileSpec = ".xls"

myFile = Dir(directory & "*" & fileSpec)
i = 1

Application.ScreenUpdating = False
Do While myFile <> ""

' Open file in hidden mode... might be faster
Set OpenWorkbook = GetObject(directory & myFile)

' Application.Workbooks.Open(Filename:=directory & myFile, ReadOnly:=True)
' List sheet names starting at A2
For j = 1 To OpenWorkbook.Sheets.Count
ws.Cells(i + 1, 1) = OpenWorkbook.Sheets(j).Name
ws.Cells(i + 1, 2) = OpenWorkbook.Name   '<--- added this line
i = i + 1
Next

OpenWorkbook.Close SaveChanges:=False
Set OpenWorkbook = Nothing
myFile = Dir
Loop
Application.ScreenUpdating = True

End Sub

[nyasa15]

Thanks Logit

[Logit]

You are welcome