'
' See:
' http://www.multidriver.jp/Cgi-bin/ASP/ASPPage.asp?P1=84
' http://fnya.cocolog-nifty.com/blog/2015/04/access-postgr-1.html
' https://excelwork.info/excel/adobofeof/
' http://fnya.cocolog-nifty.com/blog/2015/04/access-postgr-1.html
' http://yasusigi.net/iasdocs/aspdocs/ref/comp/daprop02_7.htm
' http://yasusigi.net/iasdocs/aspdocs/ref/comp/daprop03_3.htm
' https://www.moug.net/tech/acvba/0070053.html
' http://accessvba.pc-users.net/ado/open_record.html
'
' Date: 2019-03-14
'
' マクロを含むエクセルファイルは ".xlsm" ファイルに保存すること
'
' 開発タブの表示方法
' Excel 2007
' 左上の丸いボタンを押す
' 開いたメニューの一番下の [Excel のオプション]
' 基本設定
' [開発] タブをリボンに表示するにチェック
'
Option Explicit
' LockType
Const adLockReadOnly As Integer = 0 ' 既定値で読み取り専用です。データの更新・追加・削除はできません。
Const adLockPessimistic As Integer = 1 ' レコード単位で排他的ロックを行います。編集直後にレコードをロックします。
Const adLockOptimistic As Integer = 2 ' レコード単位で共有的ロックを行います。Updateメソッドを呼び出した場合にのみ、共有的ロックします。
Const adLockBatchOptimistic As Integer = 3 ' 複数のレコードをバッチ更新します。
' CursorLocation
Const adUseNone As Integer = 1 ' カーソルサービスを使いません。
Const adUseServer As Integer = 2 ' サーバー側カーソル（既定値）
Const adUseClient As Integer = 3 ' クライアント側カーソル
' CursorType
Const adOpenForwardOnly As Integer = 0 ' 前方スクロール カーソル。レコードの前方スクロールだけが可能であること以外は静的カーソルとまったく同じです。レコードセットを 1 回の操作で渡せばよい場合にこの前方スクロール カーソルを使うと、パフォーマンスが向上します (デフォルト)。
Const adOpenKeyset As Integer = 1 ' キーセット カーソル。動的カーソルに似ていますが、ほかのユーザーによるレコードの追加操作を見ることはできません。また、ほかのユーザーが自分のレコードセットからレコードを削除しているときはそのレコードにアクセスすることができません。ほかのユーザーによるデータの変更操作は見ることができます。
Const adOpenDynamic As Integer = 2 ' 動的カーソル。ほかのユーザーによる追加、変更、および削除の操作を見ることができます。ブックマークを利用する以外のすべての操作が Recordset を介して可能ですが、プロバイダがブックマークをサポートしていればそれを利用できます。
Const adOpenStatic As Integer = 3 ' 静的カーソル。データの検索やレポートの生成のために使用する、レコード集合の静的なコピーです。ほかのユーザーによるデータの追加、変更、または削除の操作を見ることはできません。
' Command
Const adCmdText As Integer = 1 ' SQL 文
Const adCmdTable As Integer = 2 ' テーブル名
Const adCmdStoredProc As Integer = 4 ' ストアド プロシージャ名
Const adCmdUnknown As Integer = 8 ' 不明（既定値）
Const adCmdFile As Integer = 256 ' 永続的に保存された Recordset のファイル名
Const adCmdTableDirect As Integer = 512 ' 列がすべて返されるテーブル名
Const adCmdUnspecified As Integer = -1 ' コマンドタイプ引数を指定しません
' Parameter
Const adParamUnKnown As Integer = 0 ' パラメータ方向不明
Const adParamInput As Integer = 1 ' 入力パラメータ（デフォルト）
Const adParamOutput As Integer = 2 ' 出力パラメータ
Const adParamInputOutput As Integer = 3 ' 入出力パラメータ
Const adParamReturnValue As Integer = 4 ' 戻り値
' DataType
Const adEmpty As Integer = 0 ' 型の指定なし
Const adBoolean As Integer = 11 ' ブール型
Const adCurrency As Integer = 6 ' 通貨型
Const adDate As Integer = 7 ' 日付型
Const adDBDate As Integer = 133 ' yyyymmdd形式の日付型
Const adDBTime As Integer = 134 ' hhmmss形式の時刻型
Const adDBTimeStamp As Integer = 135 ' yyyymmdd hhmmss形式の時刻型
Const adDecimal As Integer = 14 ' バリアント10進型
Const adDouble As Integer = 5 ' 倍精度不動小数点型
Const adError As Integer = 10 ' 32ビットエラーコード
Const adGUID As Integer = 72 ' 固有のグローバルID
Const adIDispatch As Integer = 9 ' OLEオブジェクトIdispatchインターフェースのポインタ
Const adIUnknown As Integer = 13 ' OLEオブジェクトのIUnknownインターフェースのポインタ
Const adNumeric As Integer = 131 ' 数値型
Const adSmallInt As Integer = 2 ' 2バイトの符号付整数
Const adInteger As Integer = 3 ' 4バイトの符号付整数
Const adSingle As Integer = 4 ' 単精度浮動小数点型
Const adTinyInt As Integer = 16 ' 1バイトの符号付整数
Const adUnsignedTinyInt As Integer = 17 ' 1バイトの符号無し整数
Const adUnsignedSmallInt As Integer = 18 ' 2バイトの符号無し整数
Const adUnsignedInt As Integer = 19 ' 4バイトの符号無し整数
Const adBigInt As Integer = 20 ' 8バイトの符号付整数
Const adUnsignedBigInt As Integer = 21 ' 8バイトの符号無し整数
Const adUserDefined As Integer = 132 ' ユーザー定義の変数
Const adVarBinary As Integer = 204 ' バイナリ型（パラメータオブジェクトのみ）
Const adLongVarBinary As Integer = 205 ' 長バイナリ型（パラメータオブジェクトのみ）
Const adVariant As Integer = 12 ' バリアント型
Const adBinary As Integer = 128 ' バイナリ型
Const adBSTR As Integer = 8 ' Nullで終了するUnicode文字列
Const adChar As Integer = 129 ' 文字列型
Const adWchar As Integer = 130 ' Nullで終了するUnicode文字列型1
Const adVarChar As Integer = 200 ' 文字列型（パラメータオブジェクトのみ）
Const adLongVarChar As Integer = 201 ' 長文字列型（パラメータオブジェクトのみ）
Const adVarWChar As Integer = 202 ' Nullで終了するUnicode文字列型（パラメータオブジェクトのみ）
Const adLongVarWChar As Integer = 203 ' Nullで終了するUnicode文字列型（パラメータオブジェクトのみ）
Dim adoCon As Object ' ADOコネクション
Function DBConnect()
Const ODBCDriver As String = "{MySQL ODBC 5.3 Unicode Driver}"
Const ServerAddress As String = "192.168.11.10"
Const DatabaseName As String = "DBNAME"
Const DatabaseUID As String = "DBUSERNAME"
Const DatabasePWD As String = "DBPASSWORD"
On Error GoTo DatabaseConnect
If adoCon.State = 1 Then
Debug.Print "DB接続済み"
Exit Function
End If
DatabaseConnect:
On Error GoTo ErrorTrap
' ADOコネクションを作成
Set adoCon = CreateObject("ADODB.Connection")
' ODBC接続
adoCon.Open _
"DRIVER=" & ODBCDriver & ";" & _
"SERVER=" & ServerAddress & ";" & _
"DATABASE=" & DatabaseName & ";" & _
"UID=" & DatabaseUID & ";" & _
"PWD=" & DatabasePWD & ";"
Debug.Print "DB接続成功"
Exit Function
ErrorTrap:
Set adoCon = Nothing
ErrMsgBox
End Function
Function DBDisConnect()
On Error Resume Next
adoCon.Close
Set adoCon = Nothing
End Function
Function ErrMsgBox()
Dim msg As String
If Err.Number = 0 Then Exit Function
msg = "エラー番号:" & Err.Number & vbCrLf & _
"エラー内容：" & Err.Description & vbCrLf & _
"ヘルプファイル名" & Err.HelpContext & vbCrLf & _
"プロジェクト名：" & Err.Source
Debug.Print msg
MsgBox msg
End Function
Sub test2()
Dim rs As Object ' ADOレコードセット
Dim param As Object ' ADOレコードセット
' Dim rs As ADODB.Recordset
Dim SQL As String ' SQL
Dim i As Integer
DBConnect
Dim cmd As Object
Set cmd = CreateObject("ADODB.Command")
' SQL文
SQL = "SELECT * FROM wp_posts WHERE ID = ?;"
' SQL を宣言
' SQL = "INSERT INTO users (user_id, user_name) values (?,?);"
'Commandをインスタンス化
' set cmd = New ADODB.Command
' Set cmd.ActiveConnection = con
cmd.ActiveConnection = adoCon
cmd.CommandType = adCmdText
cmd.CommandText = SQL
cmd.Prepared = True
'パラメータを作成、１つずつ
' Set param = cmd.CreateParameter("ID", adChar, adParamInput, 5)
' Set param = cmd.CreateParameter("ID", adInteger, adParamInput)
cmd.Parameters.Append cmd.CreateParameter("ID", adInteger, adParamInput)
cmd.Parameters("ID").Value = 2
' cmd.Parameters.Append cmd.CreateParameter("ID", adInteger, adParamInput, 2)
' cmd.Parameters("ID").Value = 2
' Set param = cmd.CreateParameter("NAME", adWChar, adParamInput, 255)
' cmd.Parameters.Append param
'パラメータに値を設定
' cmd.Parameters("ID").Value = uId
' cmd.Parameters("NAME").Value = uName
' トランザクション開始
' adoCon.BeginTrans
' SQL実行
Set rs = cmd.Execute
' コミット
' adoCon.CommitTrans
' rs.MoveFirst
' Cells(1, 1) = rs(0).Value
Set rs = CreateObject("ADODB.Recordset") ' New ADODB.Recordset
rs.CursorLocation = adUseClient
' rs.CursorType = adOpenStatic
rs.Open cmd
Debug.Print rs.RecordCount
Debug.Print rs.fields.Count
' SQLの実行
' Set adoRs = adoCon.Execute(SQL)
On Error GoTo ErrorTrap
rs.MoveFirst
' レコードセット内の全ての行の読込が終了するまで処理を繰り返す
i = 2
Do Until rs.EOF
' Cells(i, 1) = adoRs!post_date
' Cells(i, 2) = adoRs!post_title
Cells(i, 1) = rs("post_date")
Cells(i, 2) = rs("post_title")
i = i + 1
' 次のレコードに移動する
rs.MoveNext
Loop
Debug.Print rs.RecordCount
Debug.Print rs.fields.Count
' 解放処理
rs.Close
ErrorTrap:
Set rs = Nothing
ErrMsgBox
End Sub
Sub test3()
Dim rs As Object ' ADOレコードセット
Dim param As Object '
Dim cmd As Object ' ADODB.Command
Dim SQL As String ' SQL
Dim i As Integer
DBConnect
On Error GoTo ErrorTrap
Set cmd = CreateObject("ADODB.Command")
SQL = "SELECT * FROM wp_posts WHERE ID = ?"
cmd.ActiveConnection = adoCon
cmd.CommandType = adCmdText
cmd.CommandText = SQL
cmd.Prepared = True
cmd.Parameters.Append cmd.CreateParameter("ID", adInteger, adParamInput)
cmd.Parameters("ID").Value = 3
' SQL実行
cmd.Execute
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient
' rs.ActiveConnection = adoCon
rs.Open cmd
Debug.Print rs.RecordCount
Debug.Print rs.fields.Count
' rs.MoveFirst
' レコードセット内の全ての行の読込が終了するまで処理を繰り返す
i = 2
Do Until rs.EOF
Cells(i, 1) = rs("post_date")
Cells(i, 2) = rs("post_title")
i = i + 1
' 次のレコードに移動する
rs.MoveNext
Loop
' 解放処理
rs.Close
ErrorTrap:
Set rs = Nothing
ErrMsgBox
End Sub
'
' Usage:
' =PostTitle(2)
'
Function PostTitle(id As Integer, Optional notFoundValue = "")
Dim rs As Object ' ADOレコードセット
Dim cmd As Object ' ADODB.Command
Dim param As Object ' ADODB.Command.Parameter
Dim SQL As String ' SQL
DBConnect
On Error GoTo ErrorTrap
SQL = "SELECT * FROM wp_posts WHERE ID = ?"
Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = adoCon
cmd.CommandType = adCmdText
cmd.CommandText = SQL
cmd.Prepared = True
cmd.Parameters.Append cmd.CreateParameter("ID", adInteger, adParamInput)
cmd.Parameters("ID").Value = id
' SQL実行
cmd.Execute
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient
rs.Open cmd
PostTitle = notFoundValue
If rs.RecordCount = 0 Then
Debug.Print "PostTitle: 見つかりません: ID: " & id
Else
PostTitle = rs("post_title")
End If
' 解放処理
rs.Close
Set rs = Nothing
Set cmd = Nothing
Exit Function
ErrorTrap:
Set rs = Nothing
Set cmd = Nothing
ErrMsgBox
PostTitle = Err.Description ' エラー内容を返す
End Function
'
' Usage:
' =PostIdFromTitle("title", True/False, "Not found!")
'
Function PostIdFromTitle(post_title As String, Optional Matching As Boolean = False, Optional notFoundValue = -1)
Dim rs As Object ' ADOレコードセット
Dim cmd As Object ' ADODB.Command
Dim param As Object ' ADODB.Command.Parameter
Dim SQL As String ' SQL
DBConnect
On Error GoTo ErrorTrap
If Matching Then
SQL = "SELECT * FROM wp_posts WHERE post_title = ?"
Else
SQL = "SELECT * FROM wp_posts WHERE post_title like ?"
post_title = "%" & post_title & "%"
End If
Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = adoCon
cmd.CommandType = adCmdText
cmd.CommandText = SQL
cmd.Prepared = True
' cmd.Parameters.Append cmd.CreateParameter("post_title", adVarChar, adParamInput, 255)
' cmd.Parameters.Append cmd.CreateParameter("post_title", adVarWChar, adParamInput, 255)
cmd.Parameters.Append cmd.CreateParameter("post_title", adWchar, adParamInput, 255)
cmd.Parameters("post_title").Value = post_title
' SQL実行
cmd.Execute
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient
rs.Open cmd
PostIdFromTitle = notFoundValue
If rs.RecordCount = 0 Then
Debug.Print "PostIdFromTitle: 見つかりません: post_title: " & post_title
Else
PostIdFromTitle = rs("ID")
End If
' 解放処理
rs.Close
Set rs = Nothing
Set cmd = Nothing
Exit Function
ErrorTrap:
Set rs = Nothing
Set cmd = Nothing
ErrMsgBox
PostIdFromTitle = Err.Description ' エラー内容を返す
End Function
