'接続関係
Public cn As ADODB.connection
Public rs As ADODB.Recordset
Public cmd As ADODB.Command
Private Const adOpenDynamic As Long = 2
Private Const adLockOptimistic As Long = 3
Public Sub cnOpen(ByVal ConnectString As String)
Set cn = New ADODB.connection
cn.ConnectionString = ConnectString
cn.Open
End Sub
Public Sub cnClose()
If (rs Is Nothing) = False Then
If rs.State <> adStateClosed Then
rs.Close
End If
End If
Set rs = Nothing
If cn.State <> adStateClosed Then
cn.Close
End If
Set cn = Nothing
End Sub
Public Function ExcelConnect() As String
ExcelConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" _
& "Extended Properties=""Excel 8.0;" _
& "HDR=Yes"";"
End Function
Public Function ExcelConnectSelect(ByVal strPath As String, ByVal strBookName As String) As String
ExcelConnectSelect = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & strPath & "\" & strBookName & ";" _
& "Extended Properties=""Excel 8.0;IMEX=1" _
& "HDR=Yes"";"
End Function
'実行
Public Sub SqlExecute(ByVal strSql As String)
cnOpen (ExcelConnect)
Set cmd = New ADODB.Command
With cmd
.CommandText = strSql
.ActiveConnection = cn
.Execute
End With
cnClose
End Sub
'読み込み
Dim strSql As String
Dim dicItemDatas As New Dictionary
cnOpen (ExcelConnect)
strSql = "SELECT * FROM [ItemData$]"
Set rs = GetRecordSet(strSql, cn)
Do Until rs.EOF
With New clsItemData
Set .rec = rs
dicItemDatas.Add .Self.ID, .Self
End With
rs.MoveNext
Loop
cnClose
Set GetclsItemData = dicItemDatas