Q&A
質問のプログラムコードは[対応しているMarkdownの機能](https://teratail.com/help#about-markdown) の[コードを入力]を使いましょう。
前提・実現したいこと
SQLserverのT_GroupAccessKeyのアクセスキーコードとoracleのS20の責任者パスワードを比較して一致していなければエラー表示させるという既存のExcelVBAがあります。
そこにSQLserverのT_GroupAccessKeyの団体番号&枝番とT_Groupの団体番号&枝番を結合してT_Groupの発送区分がNull以外のものという抽出条件を一つ追加したいです。
発生している問題・エラーメッセージ
既存のVBAに構文を追加したんですが、「実行時エラー'-2147217865(80040e37)':オートメーションエラーです。」のエラーが表示されます。
該当のソースコード
VBA
1 2 3 'レコードセットを取得 4 Set adoRsWeb = New ADODB.Recordset 5 adoRsWeb.CursorLocation = adUseClient 'RecordCountの取得に設定が必要 6 7 '"配列に設定した団体番号を1件ずつSQLを実行し、データが取得されるかチェックする 8 '(受付システム側にアップロード先となる団体番号のデータが存在しているか確認する作業) 9 For intArray = 0 To MaxArray 10 11 '配列の値が空白でない場合に処理をする 12 If strCheckNoUketukeUpSakiAll(intArray) <> "" Then 13 14 'SQLの作成 15 strSQLWeb = "select * from S20 where DANTAINO in ('" & strCheckNoUketukeUpSakiAll(intArray) & "')" 16 17 'レコードセットを取得 18 adoRsWeb.Open strSQLWeb, adoConWeb, adOpenStatic, adLockReadOnly 19 20 'データが取得された場合 21 If adoRsWeb.RecordCount = 0 Then 22 Sheets("ツール").Cells(intArray + StartRowNo, ColUmu).Value = "エラー有" 23 Sheets("ツール").Cells(intArray + StartRowNo, ColError).Value = "受付システムに団体番号がありません" 24 'データが取得されなかった場合（ここでは、"エラー無"に設定） 25 ElseIf adoRsWeb.RecordCount <> 0 And _ 26 strCheckNoUketukeUpSakiAll(intArray) = adoRsWeb!DANTAINO And _ 27 Sheets("ツール").Cells(intArray + StartRowNo, ColUmu).Value = "受付エラー無" Then 28 Sheets("ツール").Cells(intArray + StartRowNo, ColUmu).Value = "エラー無" 29 End If 30 31 '"ツール"Sheetにアップロード先の団体番団を設定 32 '（UPLOADSAKIGROUPIDにデータがある場合のみ設定、無い場合は空欄） 33 Sheets("ツール").Cells(intArray + StartRowNo, ColUpsaki).Value = strCheckNoUketukeUpSakiDiffer(intArray) 34 35 'レコードセットを閉じる 36 adoRsWeb.Close 37 38 End If 39 40 Next intArray 41 42 DBConnectCheck 43 44 45 'MS SQLServer側のレコードセットを定義 46 Set adoRsPass = New ADODB.Recordset 47 48 Dim passCheck As String 49 Dim passWeb As String 50 51 For intArray = 0 To MaxArray 52 53 '配列の値が空白でない場合に処理をする 54 If strCheckNoUketukeUpSakiAll(intArray) <> "" Then 55 56'---------------------------------------------- 57'ここから追加 58'SQLの作成 59strDis = "SELECT T_GroupAccessKey.GroupID, T_GroupAccessKey.BranchNo, T_GroupAccessKey.AccessKeyCD, T_GroupAccessKey.AccessKeyKind, T_GroupAccessKey.AccessKey, T_GroupAccessKey.ApprovalFlag, T_GroupAccessKey.UpdateName, T_GroupAccessKey.UpdateDate, T_Group.DispatchKbn FROM T_GroupAccessKey LEFT JOIN T_Group ON (T_GroupAccessKey.BranchNo = T_Group.BranchNo) AND (T_GroupAccessKey.GroupID = T_Group.GroupID) WHERE (((T_Group.DispatchKbn)<>''))" 60'ここまで 61'---------------------------------------------- 62 63 '---- MS SQLServer側(団体アクセスキーテーブル) 64 'SQLの作成 65'----------------------------------------------- 66' strSQLCheck = " select * from T_GroupAccessKey " _ 67' & " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _ 68' & " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _ 69' & " AND AccessKeyKind = '1'" 70' & " AND AccessKeyCD = '28' AND AccessKeyKind = '1'" 71'----------------------------------------------- 72 73'---------------------------------------------- 74'ここから追加 75 strSQLCheck = " select * from strDis " _ 76 & " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _ 77 & " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _ 78 & " AND AccessKeyKind = '1'" 79'ここまで 80'---------------------------------------------- 81 82 'レコードセットを取得 83 adoRsPass.Open strSQLCheck, adoConCheck, adOpenStatic, adLockReadOnly 84 85 '---- Oracle 側(団体情報マスタ) 86 'SQLの作成 87 strSQLWeb = "select * from S20 where DANTAINO = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" 88 89 'レコードセットを取得 90 adoRsWeb.Open strSQLWeb, adoConWeb, adOpenStatic, adLockReadOnly 91 92 'T_GroupAccessKey、S20 双方のパスワードを突合せ 93 94 '判定フラグ（パスワード一致=1） 95 hanteiFlg = 0 96 Do While Not adoRsPass.EOF 97 98 Do While Not adoRsWeb.EOF 99 100 passWeb = adoRsWeb!SEKININSHAPSW 101 passCheck = adoRsPass!AccessKey 102 103 If passWeb = passCheck Then 104 105 hanteiFlg = 1 106 107 End If 108 adoRsWeb.MoveNext 109 110 Loop 111 adoRsPass.MoveNext 112 113 Loop 114 115 'レコードセットを閉じる 116 adoRsPass.Close 117 adoRsWeb.Close 118 119 'パスワードが一致した場合 120 If hanteiFlg = 1 Then 121 122 Sheets("ツール").Cells(intArray + StartRowNo, ColUmu).Value = "エラー無" 123 Sheets("ツール").Cells(intArray + StartRowNo, ColError).Value = "" 124 Sheets("ツール").Cells(intArray + StartRowNo, 7).Value = "" 125 Sheets("ツール").Cells(intArray + StartRowNo, 8).Value = "" 126 127 Else 128 129 If Sheets("ツール").Cells(intArray + StartRowNo, ColUmu).Value = "エラー無" Then 130 131 Sheets("ツール").Cells(intArray + StartRowNo, ColUmu).Value = "エラー有" 132 Sheets("ツール").Cells(intArray + StartRowNo, ColError).Value = "受付システムのパスワードが違います" 133 Sheets("ツール").Cells(intArray + StartRowNo, 7).Value = passWeb 134 Sheets("ツール").Cells(intArray + StartRowNo, 8).Value = passCheck 135 136 End If 137 138 End If 139 140 End If 141 142 Next intArray 143 144 DBDisConnectCheck 145 146 With Application 147 .ScreenUpdating = True 148 .EnableEvents = True 149 .Calculation = xlCalculationAutomatic 150 End With 151 152 'DBの切断 153 DBDisConnectUketuke 154 DBDisConnectWeb 155 156 MsgBox "処理が完了しました" 157 158End Sub 159
###修正前
Set adoRsPass = New ADODB.Recordset Dim passCheck As String Dim passWeb As String For intArray = 0 To MaxArray '配列の値が空白でない場合に処理をする If strCheckNoUketukeUpSakiAll(intArray) <> "" Then '---- MS SQLServer側(団体アクセスキーテーブル) 'SQLの作成 '----------------------------------------------- strSQLCheck = " select * from T_GroupAccessKey " _ & " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _ & " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _ & " AND AccessKeyKind = '1'" '-----------------------------------------------
###修正後
'MS SQLServer側のレコードセットを定義 Set adoRsPass = New ADODB.Recordset Dim passCheck As String Dim passWeb As String For intArray = 0 To MaxArray '配列の値が空白でない場合に処理をする If strCheckNoUketukeUpSakiAll(intArray) <> "" Then 'SQLの作成 strDis = "SELECT T_GroupAccessKey.GroupID, T_GroupAccessKey.BranchNo, T_GroupAccessKey.AccessKeyCD, T_GroupAccessKey.AccessKeyKind, T_GroupAccessKey.AccessKey, T_GroupAccessKey.ApprovalFlag, T_GroupAccessKey.UpdateName, T_GroupAccessKey.UpdateDate, T_Group.DispatchKbn FROM T_GroupAccessKey LEFT JOIN T_Group ON (T_GroupAccessKey.BranchNo = T_Group.BranchNo) AND (T_GroupAccessKey.GroupID = T_Group.GroupID) WHERE (((T_Group.DispatchKbn)<>''))" '---- MS SQLServer側(団体アクセスキーテーブル) 'SQLの作成 '----------------------------------------------- strSQLCheck = " select * from strDis " _ & " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _ & " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _ & " AND AccessKeyKind = '1'" '---------------------------------------------- 'レコードセットを取得 adoRsPass.Open strSQLCheck, adoConCheck, adOpenStatic, adLockReadOnly
補足情報（FW/ツールのバージョンなど）
Excel2016
【ソフト名】 A5:SQL Mk-2 Version 2.11.6
ソフトウェア名： osqledit
Orlofskyさん URLに()つける場合は前後に半角空白か何か入れておかないとそこもURLと認識され、置換されてしまいます。（あとコメント欄ではマークダウン使えないので・・・）
mts10806さん、勉強なります。 コメント欄も、回答欄と同じ仕様にしてほしいもんですね。。。
追記修正依頼はあくまでちょっとした指摘とかに使われるのがほとんどなのでいいかと思いますが、回答へのコメントについてはマークダウン使えるようにしてもらえると助かりますね。確かにコメントのやりとりはほとんど回答者と質問者のやりとりのみで使われるもので必ず見た人が目につく回答に全て反映すべきみたいな考えは分からないでもないですが・・・。
mts10806さん、ご指導ありがとうございます。事務局には1年以上前からここやコメント欄にもマークダウンを使えるようにお願いしているんですが、直す気があるのかどうか？もっと使い易い掲示板があると良いですね。
bakoさん色々修正されていますが、最初の指摘の対応がなされていません。 プログラムコード(およびエラーメッセージ)は```で囲ってください。（わからなければ質問編集画面でコード部分を選択し<code>ボタンを押してください）正しく反映されているかどうかは質問編集画面のプレビューを見ながら編集していってください。
Orlofskyさん コメントはあくまで確認と補足という認識かもしれませんね。現実的にはコメントでコードがかなりの勢いで飛び交っているので、現在のユーザーの運用にあわせて改善してもらえればとは私も思います（あと質問投稿時に初期状態で初心者アイコンONとか）
回答2件
0
見にくいのでちょっとコードを整形します。
現状は以下になっています。
VBA
1strSQLCheck = _ 2 "select * from strDis " & _ 3 " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" & _ 4 " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where Convert(varchar, current_timestamp, 112) " & _ 5 " between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" & _ 6 " AND AccessKeyKind = '1'"
strDisが文字列内で記述されているので、変数になっていませんので、「そんなテーブルは無い」というエラーです。
また、変数を展開するということはサブクエリーですから、()で括る必要があります。エイリアスも付けたほうがいいですね。
VBA
1strSQLCheck = _ 2 "select * from (" & strDis & ") Dis " _ 3 " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" & _ 4 " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where Convert(varchar, current_timestamp, 112) " & _ 5 " between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" & _ 6 " AND AccessKeyKind = '1'"
ただ上記でも、accesskeyfromとaccesskeytoは見当たりませんので、エラーは解消しないと思います。
M_AccessKeyPeriodのサブクエリーでした。
投稿2018/05/10 06:38
編集2018/05/10 06:51
総合スコア25430
0
１つめに作成したSQL文を格納した変数名が、２つめのSQL文中に文字列として格納されています。
１つめのSQL
strDis = "SELECT T_GroupAccessKey.GroupID, T_GroupAccessKey.BranchNo, ～
２つめのSQL
strSQLCheck = " select * from strDis " _
ダブルクォーテーションで括った文字列内に変数名を直接書いてしまうと、値が展開されないので意味がないです。
また１つめのSQLを２つめのサブクエリとしたいのであれば、括弧で括らないとうまく動かないような気がします。
元々こういう作りなんでしょうか？
条件を追加しただけであればそうなんでしょうけど…。
修正前と修正後のコードを載せたほうが話は早いかもしれませんね。
投稿2018/05/10 06:07
総合スコア17000
あなたの回答
tips
プレビュー
