書式を直すだけなら、ふつーに正規表現とかでぱたぱたと出来たのだけど、
なにしろボクはVBAのお約束を知らない。
参照渡しをSetにするとかゆーのは、あちこちで見かけたので問題なかったのだけど、
まさか、引数を渡すのに括弧つけちゃダメな言語があったとはっ！と…
あとアレだ。Class内部のコーディングのミスを、
呼び出し側のPropertyの設定ミスとしてエラー吐くのはどうよ。
そこカプセル化しちゃダメだよね？てなトコロ。
Openさせたときにエラー吐かせて拾おうとしたら、
Class内部でのエラー回避処理には引っかからず、
Open Method読んでるトコでエラー吐くし。内部でのチェック意味ねー( ﾟ-ﾟ)~ﾟ
仕上がりはけっこーおざなり。
とりあえず動いたからいいや的な作りなので、丸写しで追求しないか、
使いやすいようカスタマイズしてください( ﾟ-ﾟ)~ﾟ
参考：AccessアクセスClassをVBAに移植してみた～呼び出し側～
(Class Module : SetDBtoTable )
Option Explicit
'指定したDBを読み込み、テーブルで返す。
'----------
'Variable
'----------
Private m_Provider As String
Private m_DataSource As String
Private m_ConnectionString As String
Private m_UserID As String
Private m_Password As String
Private m_RecordCount As Integer
Private m_ColumnCount As Integer
Private m_DataTable() As String 'テーブルデータ格納場所
Private cn As ADODB.Connection
Private rs As ADODB.Recordset
'----------
'Property
'----------
'------------------------------
'DBへアクセスするために必要なProperty群
'------------------------------
'プロバイダ指定。Accessなら"Microsoft.Jet.OLEDB.4.0;"みたいなの
Property Get Provider() As String
Provider = m_Provider
End Property
Property Let Provider(Provider As String)
m_Provider = Provider
End Property
'データソース指定。Accessならファイル名
Property Get DataSource() As String
DataSource = m_DataSource
End Property
Property Let DataSource(DataSource As String)
m_DataSource = DataSource
End Property
'コネクションストリング。テーブル名だったりSQLだったり
Property Get ConnectionString() As String
ConnectionString = m_ConnectionString
End Property
Property Let ConnectionString(ConnectionString As String)
m_ConnectionString = ConnectionString
End Property
'ユーザーID。テストしてないから動くかどうかわからない( ﾟ-ﾟ)~ﾟ
Property Get UserID() As String
UserID = m_UserID
End Property
Property Let UserID(UserID As String)
m_UserID = UserID
End Property
'パスワード。テストしてな（以下略
Property Get Password() As String
Password = m_Password
End Property
Property Let Password(Password As String)
m_Password = Password
End Property
'------------------------------
'得たデータを参照するProperty群
'------------------------------
'レコード数
Property Get RecordCount() As Long
RecordCount = m_RecordCount
End Property
'カラム数
Property Get ColumnCount() As Long
ColumnCount = m_ColumnCount
End Property
'Value Override群 Start…って思ったら、Overrideできないでやんの( ﾟ-ﾟ)~ﾟ
Property Get Value() As String()
Value = m_DataTable
End Property
'Item Override群 Start Default Property指定。Default指定もできないでやんの
Property Get Item(ByVal i As Integer, ByVal j As Integer) As String
Item = m_DataTable(i, j)
End Property
Property Get Record(ByVal i As Integer) As String()
Record = m_Record(i)
End Property
Property Get Column(ByVal j As Integer) As String()
Column = m_Column(j)
End Property
'----------
'Constructor
'----------
Private Sub Class_Initialize()
Debug.Print ("Constructor:" & TypeName(Me))
m_Provider = "Microsoft.Jet.OLEDB.4.0;"
End Sub
'----------
'Destructor
'----------
Private Sub Class_Terminate()
Debug.Print ("Destructor:" & TypeName(Me))
End Sub
'----------
'Method
'----------
'DBにアクセスし、レコード数、カラム数、データ本体を読み込み、Class変数に代入
Public Function OpenDB() As Boolean
Dim OnOK As Boolean
OnOK = True
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim i As Integer
Dim j As Integer
cn.Provider = m_Provider
'_ConnectionStringが空か確認。空であればエラーを吐きFalseを返してMethod終了
If m_ConnectionString = "" Then
Debug.Print ("ERROR:" & TypeName(Me) & ":ConnectionString Property Not Assignment")
OnOK = False
OpenDB = OnOK
End If
'DataSourceが空か確認。空であればエラーを吐きFalseを返してMethod終了
If m_DataSource = "" Then
Debug.Print ("ERROR:" & TypeName(Me) & ":DataSource Property Not Assignment")
OnOK = False
OpenDB = OnOK
Exit Function
End If
'DataSource設定
cn.Properties("Data Source").Value = m_DataSource
'ID/Passwd設定（試してない
If m_UserID <> "" Then
cn.Properties("UserID").Value = m_UserID
End If
If m_Password <> "" Then
cn.Properties("Password").Value = m_Password
End If
On Error GoTo Error_Handler
cn.Open
'ConnectionString(テーブ名やSQL。DELETEとか書かれても、
'rs.open()のときにReadOnlyで開くからはじけると思う
rs.Source = m_ConnectionString
rs.ActiveConnection = cn
rs.CursorType = ADODB.CursorTypeEnum.adOpenKeyset
rs.LockType = ADODB.LockTypeEnum.adLockReadOnly
rs.Open
m_RecordCount = rs.RecordCount
m_ColumnCount = rs.Fields.Count
ReDim m_DataTable(m_RecordCount - 1, m_ColumnCount - 1)
i = 0
Do Until rs.EOF
For j = 0 To m_ColumnCount - 1
m_DataTable(i, j) = rs.Fields(j).Value
Next j
rs.MoveNext
i = i + 1
Loop
OpenDB = OnOK
Exit Function
Error_Handler:
'Try中のエラーのとき cnとrsのopen、データ取り込み時それぞれで節を分ければError位置が特定できる。はず。
Debug.Print ("ERROR:" & TypeName(Me) & ":DB or RS Open failed")
OnOK = False
Error_Handler_End:
OpenDB = OnOK
End Function
'クローズ。ホントは必要なさそうなんだけど、OpenしたからにはCloseしたくなるのは本能。
'VBAはちゃんとデストラクタくんが動いてくれるのでcallはしない。。
Public Sub CloseDB()
rs.Close
cn.Close
Erase m_DataTable
End Sub
Public Sub putData()
rs.MoveFirst
ActiveCell.CopyFromRecordset rs
End Sub
Public Sub putRange(Arg_Range As String, Optional Worksheet As String)
rs.MoveFirst
If Worksheet = vbNullString Then
ActiveSheet.Range(Arg_Range).CopyFromRecordset rs
Else
Worksheets(Worksheet).Range(Arg_Range).CopyFromRecordset rs
End If
End Sub
Public Sub putCells(ByVal Row As Integer, ByVal Col As Integer, Optional ByVal Worksheet As String)
rs.MoveFirst
If Worksheet = vbNullString Then
ActiveSheet.Cells(Row, Col).CopyFromRecordset rs
Else
Worksheets(Worksheet).Cells(Row, Col).CopyFromRecordset rs
End If
End Sub
'----------
'Private Function
'----------
'データ要素単体渡し。stringで返す。範囲外のINDEX渡すと怒られるぞ。
Private Function m_Item(ByVal i As Integer, ByVal j As Integer) As String
m_Item = m_DataTable(i, j)
End Function
'INDEXのRecordの要素全てを、Stringの１元配列型で返す。
Private Function m_Record(ByVal i As Integer) As String()
Dim ReturnTable() As String
Dim j As Integer
ReDim ReturnTable(m_ColumnCount - 1)
For j = 0 To m_ColumnCount - 1
ReturnTable(j) = m_DataTable(i, j)
Next j
m_Record = ReturnTable
End Function
'INDEXのColumnの要素全てを、Stringの１元配列型で返す。
Private Function m_Column(ByVal j As Integer) As String()
Dim ReturnTable() As String
Dim i As Integer
ReDim ReturnTable(m_RecordCount - 1)
For i = 0 To m_RecordCount - 1
ReturnTable(i) = m_DataTable(i, j)
Next i
m_Column = ReturnTable
End Function