ExcelマクロVBAサンプル集 | Excelファイルを開かずにシート名を取得 | ExcelマクロVBAの実用サンプル、エクセルVBA集と解説

Sub getSheet()
　　Dim objCn As New ADODB.Connection
　　Dim objRS As ADODB.Recordset
　　Dim sFile As String
　　Dim sSheet As String
　　Dim i　　　As Long
　　
　　sFile = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*")
　　If sFile = "False" Then
　　　　Exit Sub
　　End If
　　
　　With objCn
　　　　.Provider = "Microsoft.ACE.OLEDB.12.0"
　　　　.Properties("Extended Properties") = "Excel 12.0"
　　　　.Open sFile
　　　　Set objRS = .OpenSchema(ADODB.adSchemaTables)
　　End With
　　
　　i = 1
　　Do Until objRS.EOF
　　　　sSheet = objRS.Fields("TABLE_NAME").Value
　　　　If Right(sSheet, 1) = "$" Or Right(sSheet, 2) = "$'" Then
　　　　　　If Right(sSheet, 1) = "$" Then
　　　　　　　　sSheet = Left(sSheet, Len(sSheet) - 1)
　　　　　　End If
　　　　　　If Right(sSheet, 2) = "$'" Then
　　　　　　　　sSheet = Left(sSheet, Len(sSheet) - 2)
　　　　　　End If
　　　　　　If Left(sSheet, 1) = "'" Then
　　　　　　　　sSheet = Mid(sSheet, 2)
　　　　　　End If
　　　　　　sSheet = Replace(sSheet, "''", "'")
　　　　　　Cells(i, 1) = sSheet
　　　　　　i = i + 1
　　　　End If
　　　　objRS.MoveNext
　　Loop
　　objRS.Close
　　objCn.Close
　　Set objRS = Nothing
　　Set objCn = Nothing
End Sub