ブックの中を見るとき、シート名が可変の時があります。
例 [日報0812] というように、シート名に日付が付与されています。
こんなときは、シート名の一覧を取得し、それから、対象シートを絞り込むことになります。
ADOを使う方法があったので、
シート名の配列を返す関数をつくりました。
'******************************************************************************************
' Name : fnc_GetShName '指定ブックのシート名一覧を取得する
' Return : シート名（配列）
' Param : sFile = 指定ブック名
'
'******************************************************************************************
Public Function fnc_GetShName(ByVal sFile As String) As String()
Dim objCn As New ADODB.Connection
Dim objRS As ADODB.Recordset
Dim sSheet As String
Dim i As Long
Dim sRes() As String
'
If sFile = "False" Then
Exit Function
End If
With objCn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties") = "Excel 12.0"
.Open sFile 'ReadOnly:=True
Set objRS = .OpenSchema(ADODB.adSchemaTables)
End With
ReDim sRes(0)
i = 0
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, "''", "'")
'sResに記入
ReDim Preserve sRes(i)
sRes(i) = sSheet
i = i + 1
End If
objRS.MoveNext
Loop
fnc_GetShName = sRes
objRS.Close
objCn.Close
Set objRS = Nothing
Set objCn = Nothing
End Function
