Function open_ado_excel(myBook As Variant) As Long
Dim myLink As String
Dim cn As Object
On Error Resume Next
Set cn = CreateObject("adodb.connection")
myLink = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & myBook & ";" & _
"Extended Properties=Excel 8.0;"
cn.Open myLink
open_ado_excel = Err.Number
On Error GoTo 0
End Function
Sub close_ado()
Dim cn As Object
On Error Resume Next
cn.Close
Set cn = Nothing
On Error GoTo 0
End Sub
Sub myPasswordCheck()
Dim myFile As Variant
Const myError = -2147467259
myFile = Dir("*.xls")
Do Until myFile = ""
If open_ado_excel(myFile) = myError Then
MsgBox "パスワードが設定されています"
Else
MsgBox "パスワードはありません"
End If
myFile = Dir()
Loop
close_ado
