質問編集履歴
4
タグを変更
title
CHANGED
File without changes
|
body
CHANGED
File without changes
|
3
何度もすみません。使い方がよくわかってませんでした。```で括りました。
title
CHANGED
File without changes
|
body
CHANGED
@@ -8,8 +8,51 @@
|
|
8
8
|
|
9
9
|
### 該当のソースコード
|
10
10
|
```VBA
|
11
|
+
|
12
|
+
|
13
|
+
'レコードセットを取得
|
14
|
+
Set adoRsWeb = New ADODB.Recordset
|
15
|
+
adoRsWeb.CursorLocation = adUseClient 'RecordCountの取得に設定が必要
|
16
|
+
|
17
|
+
'"配列に設定した団体番号を1件ずつSQLを実行し、データが取得されるかチェックする
|
18
|
+
'(受付システム側にアップロード先となる団体番号のデータが存在しているか確認する作業)
|
19
|
+
For intArray = 0 To MaxArray
|
20
|
+
|
21
|
+
'配列の値が空白でない場合に処理をする
|
22
|
+
If strCheckNoUketukeUpSakiAll(intArray) <> "" Then
|
23
|
+
|
24
|
+
'SQLの作成
|
25
|
+
strSQLWeb = "select * from S20 where DANTAINO in ('" & strCheckNoUketukeUpSakiAll(intArray) & "')"
|
26
|
+
|
27
|
+
'レコードセットを取得
|
28
|
+
adoRsWeb.Open strSQLWeb, adoConWeb, adOpenStatic, adLockReadOnly
|
29
|
+
|
30
|
+
'データが取得された場合
|
31
|
+
If adoRsWeb.RecordCount = 0 Then
|
32
|
+
Sheets("ツール").Cells(intArray + StartRowNo, ColUmu).Value = "エラー有"
|
33
|
+
Sheets("ツール").Cells(intArray + StartRowNo, ColError).Value = "受付システムに団体番号がありません"
|
34
|
+
'データが取得されなかった場合(ここでは、"エラー無"に設定)
|
35
|
+
ElseIf adoRsWeb.RecordCount <> 0 And _
|
36
|
+
strCheckNoUketukeUpSakiAll(intArray) = adoRsWeb!DANTAINO And _
|
37
|
+
Sheets("ツール").Cells(intArray + StartRowNo, ColUmu).Value = "受付エラー無" Then
|
38
|
+
Sheets("ツール").Cells(intArray + StartRowNo, ColUmu).Value = "エラー無"
|
11
|
-
|
39
|
+
End If
|
40
|
+
|
41
|
+
'"ツール"Sheetにアップロード先の団体番団を設定
|
42
|
+
'(UPLOADSAKIGROUPIDにデータがある場合のみ設定、無い場合は空欄)
|
43
|
+
Sheets("ツール").Cells(intArray + StartRowNo, ColUpsaki).Value = strCheckNoUketukeUpSakiDiffer(intArray)
|
44
|
+
|
45
|
+
'レコードセットを閉じる
|
46
|
+
adoRsWeb.Close
|
47
|
+
|
48
|
+
End If
|
49
|
+
|
50
|
+
Next intArray
|
51
|
+
|
52
|
+
DBConnectCheck
|
53
|
+
|
54
|
+
|
12
|
-
|
55
|
+
'MS SQLServer側のレコードセットを定義
|
13
56
|
Set adoRsPass = New ADODB.Recordset
|
14
57
|
|
15
58
|
Dim passCheck As String
|
@@ -17,46 +60,48 @@
|
|
17
60
|
|
18
61
|
For intArray = 0 To MaxArray
|
19
62
|
|
20
|
-
|
63
|
+
'配列の値が空白でない場合に処理をする
|
21
64
|
If strCheckNoUketukeUpSakiAll(intArray) <> "" Then
|
22
65
|
|
23
|
-
|
24
|
-
|
25
|
-
|
26
|
-
strDis = "SELECT T_GroupAccessKey.GroupID, T_GroupAccessKey.BranchNo,
|
27
|
-
|
28
|
-
|
29
|
-
T_Group.DispatchKbn FROM T_GroupAccessKey
|
30
|
-
LEFT JOIN T_Group ON (T_GroupAccessKey.BranchNo = T_Group.BranchNo) AND
|
31
|
-
(T_GroupAccessKey.GroupID = T_Group.GroupID) WHERE (((T_Group.DispatchKbn)<>''))"
|
32
|
-
**ここまで**
|
33
|
-
**----------------------------------------------**
|
66
|
+
'----------------------------------------------
|
67
|
+
'ここから追加
|
68
|
+
'SQLの作成
|
69
|
+
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)<>''))"
|
70
|
+
'ここまで
|
71
|
+
'----------------------------------------------
|
34
72
|
|
35
|
-
|
36
|
-
|
37
|
-
|
38
|
-
*
|
73
|
+
'---- MS SQLServer側(団体アクセスキーテーブル)
|
74
|
+
'SQLの作成
|
75
|
+
'-----------------------------------------------
|
76
|
+
' strSQLCheck = " select * from T_GroupAccessKey " _
|
77
|
+
' & " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _
|
78
|
+
' & " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _
|
79
|
+
' & " AND AccessKeyKind = '1'"
|
80
|
+
' & " AND AccessKeyCD = '28' AND AccessKeyKind = '1'"
|
81
|
+
'-----------------------------------------------
|
82
|
+
|
83
|
+
'----------------------------------------------
|
84
|
+
'ここから追加
|
39
85
|
strSQLCheck = " select * from strDis " _
|
40
86
|
& " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _
|
41
|
-
& " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod
|
42
|
-
where CONVERT(varchar,current_timestamp,112)
|
43
|
-
between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _
|
87
|
+
& " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _
|
44
88
|
& " AND AccessKeyKind = '1'"
|
45
|
-
|
89
|
+
'ここまで
|
46
|
-
|
90
|
+
'----------------------------------------------
|
91
|
+
|
47
|
-
|
92
|
+
'レコードセットを取得
|
48
93
|
adoRsPass.Open strSQLCheck, adoConCheck, adOpenStatic, adLockReadOnly
|
49
94
|
|
50
|
-
|
95
|
+
'---- Oracle 側(団体情報マスタ)
|
51
|
-
|
96
|
+
'SQLの作成
|
52
97
|
strSQLWeb = "select * from S20 where DANTAINO = '" & strCheckNoUketukeUpSakiAll(intArray) & "'"
|
53
98
|
|
54
|
-
|
99
|
+
'レコードセットを取得
|
55
100
|
adoRsWeb.Open strSQLWeb, adoConWeb, adOpenStatic, adLockReadOnly
|
56
101
|
|
57
|
-
|
102
|
+
'T_GroupAccessKey、S20 双方のパスワードを突合せ
|
58
103
|
|
59
|
-
|
104
|
+
'判定フラグ(パスワード一致=1)
|
60
105
|
hanteiFlg = 0
|
61
106
|
Do While Not adoRsPass.EOF
|
62
107
|
|
@@ -77,11 +122,11 @@
|
|
77
122
|
|
78
123
|
Loop
|
79
124
|
|
80
|
-
|
125
|
+
'レコードセットを閉じる
|
81
126
|
adoRsPass.Close
|
82
127
|
adoRsWeb.Close
|
83
128
|
|
84
|
-
|
129
|
+
'パスワードが一致した場合
|
85
130
|
If hanteiFlg = 1 Then
|
86
131
|
|
87
132
|
Sheets("ツール").Cells(intArray + StartRowNo, ColUmu).Value = "エラー無"
|
@@ -114,16 +159,18 @@
|
|
114
159
|
.Calculation = xlCalculationAutomatic
|
115
160
|
End With
|
116
161
|
|
117
|
-
|
162
|
+
'DBの切断
|
118
163
|
DBDisConnectUketuke
|
119
164
|
DBDisConnectWeb
|
120
165
|
|
121
166
|
MsgBox "処理が完了しました"
|
122
167
|
|
123
|
-
End Sub
|
168
|
+
End Sub
|
124
169
|
|
170
|
+
```
|
171
|
+
|
125
172
|
###修正前
|
126
|
-
|
173
|
+
``` 'MS SQLServer側のレコードセットを定義
|
127
174
|
Set adoRsPass = New ADODB.Recordset
|
128
175
|
|
129
176
|
Dim passCheck As String
|
@@ -131,20 +178,22 @@
|
|
131
178
|
|
132
179
|
For intArray = 0 To MaxArray
|
133
180
|
|
134
|
-
|
181
|
+
'配列の値が空白でない場合に処理をする
|
135
|
-
|
182
|
+
If strCheckNoUketukeUpSakiAll(intArray) <> "" Then
|
136
183
|
|
137
184
|
|
138
|
-
|
185
|
+
'---- MS SQLServer側(団体アクセスキーテーブル)
|
139
|
-
|
186
|
+
'SQLの作成
|
140
|
-
|
187
|
+
'-----------------------------------------------
|
141
188
|
strSQLCheck = " select * from T_GroupAccessKey " _
|
142
189
|
& " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _
|
143
190
|
& " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _
|
144
191
|
& " AND AccessKeyKind = '1'"
|
145
|
-
|
192
|
+
'-----------------------------------------------
|
193
|
+
```
|
146
194
|
###修正後
|
195
|
+
```
|
147
|
-
|
196
|
+
'MS SQLServer側のレコードセットを定義
|
148
197
|
Set adoRsPass = New ADODB.Recordset
|
149
198
|
|
150
199
|
Dim passCheck As String
|
@@ -152,23 +201,24 @@
|
|
152
201
|
|
153
202
|
For intArray = 0 To MaxArray
|
154
203
|
|
155
|
-
|
204
|
+
'配列の値が空白でない場合に処理をする
|
156
205
|
If strCheckNoUketukeUpSakiAll(intArray) <> "" Then
|
157
206
|
|
158
|
-
|
207
|
+
'SQLの作成
|
159
208
|
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)<>''))"
|
160
209
|
|
161
|
-
|
210
|
+
'---- MS SQLServer側(団体アクセスキーテーブル)
|
162
|
-
|
211
|
+
'SQLの作成
|
163
|
-
|
212
|
+
'-----------------------------------------------
|
164
213
|
strSQLCheck = " select * from strDis " _
|
165
214
|
& " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _
|
166
215
|
& " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _
|
167
216
|
& " AND AccessKeyKind = '1'"
|
168
|
-
|
217
|
+
'----------------------------------------------
|
169
218
|
|
170
|
-
|
219
|
+
'レコードセットを取得
|
171
220
|
adoRsPass.Open strSQLCheck, adoConCheck, adOpenStatic, adLockReadOnly
|
221
|
+
```
|
172
222
|
### 補足情報(FW/ツールのバージョンなど)
|
173
223
|
|
174
224
|
Excel2016
|
2
修正したsauceを載せました。
title
CHANGED
File without changes
|
body
CHANGED
@@ -121,10 +121,54 @@
|
|
121
121
|
MsgBox "処理が完了しました"
|
122
122
|
|
123
123
|
End Sub
|
124
|
-
### 試したこと
|
125
124
|
|
126
|
-
|
125
|
+
###修正前
|
126
|
+
**MS SQLServer側のレコードセットを定義**
|
127
|
+
Set adoRsPass = New ADODB.Recordset
|
128
|
+
|
129
|
+
Dim passCheck As String
|
130
|
+
Dim passWeb As String
|
131
|
+
|
132
|
+
For intArray = 0 To MaxArray
|
133
|
+
|
134
|
+
**配列の値が空白でない場合に処理をする**
|
135
|
+
If strCheckNoUketukeUpSakiAll(intArray) <> "" Then
|
136
|
+
|
137
|
+
|
138
|
+
**---- MS SQLServer側(団体アクセスキーテーブル)**
|
139
|
+
**SQLの作成**
|
140
|
+
**-----------------------------------------------**
|
141
|
+
strSQLCheck = " select * from T_GroupAccessKey " _
|
142
|
+
& " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _
|
143
|
+
& " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _
|
144
|
+
& " AND AccessKeyKind = '1'"
|
145
|
+
**-----------------------------------------------**
|
146
|
+
###修正後
|
147
|
+
**MS SQLServer側のレコードセットを定義**
|
148
|
+
Set adoRsPass = New ADODB.Recordset
|
149
|
+
|
150
|
+
Dim passCheck As String
|
151
|
+
Dim passWeb As String
|
152
|
+
|
153
|
+
For intArray = 0 To MaxArray
|
154
|
+
|
155
|
+
**配列の値が空白でない場合に処理をする**
|
156
|
+
If strCheckNoUketukeUpSakiAll(intArray) <> "" Then
|
157
|
+
|
158
|
+
**SQLの作成**
|
159
|
+
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)<>''))"
|
160
|
+
|
161
|
+
**---- MS SQLServer側(団体アクセスキーテーブル)**
|
162
|
+
**SQLの作成**
|
163
|
+
**-----------------------------------------------**
|
164
|
+
strSQLCheck = " select * from strDis " _
|
165
|
+
& " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _
|
166
|
+
& " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _
|
167
|
+
& " AND AccessKeyKind = '1'"
|
168
|
+
**----------------------------------------------**
|
127
169
|
|
170
|
+
**レコードセットを取得**
|
171
|
+
adoRsPass.Open strSQLCheck, adoConCheck, adOpenStatic, adLockReadOnly
|
128
172
|
### 補足情報(FW/ツールのバージョンなど)
|
129
173
|
|
130
174
|
Excel2016
|
1
使い方が分からずすみません。コメントアウトは太字にしました。コードは見やすいように改行しました。
title
CHANGED
File without changes
|
body
CHANGED
@@ -7,7 +7,9 @@
|
|
7
7
|
既存のVBAに構文を追加したんですが、「実行時エラー'-2147217865(80040e37)':オートメーションエラーです。」のエラーが表示されます。
|
8
8
|
|
9
9
|
### 該当のソースコード
|
10
|
+
```VBA
|
11
|
+
```
|
10
|
-
|
12
|
+
**MS SQLServer側のレコードセットを定義**
|
11
13
|
Set adoRsPass = New ADODB.Recordset
|
12
14
|
|
13
15
|
Dim passCheck As String
|
@@ -15,47 +17,46 @@
|
|
15
17
|
|
16
18
|
For intArray = 0 To MaxArray
|
17
19
|
|
18
|
-
|
20
|
+
**配列の値が空白でない場合に処理をする**
|
19
21
|
If strCheckNoUketukeUpSakiAll(intArray) <> "" Then
|
20
22
|
|
21
|
-
|
22
|
-
|
23
|
-
|
24
|
-
strDis = "SELECT T_GroupAccessKey.GroupID, T_GroupAccessKey.BranchNo,
|
25
|
-
|
26
|
-
|
23
|
+
**----------------------------------------------**
|
24
|
+
**ここから追加**
|
25
|
+
**SQLの作成**
|
26
|
+
strDis = "SELECT T_GroupAccessKey.GroupID, T_GroupAccessKey.BranchNo,
|
27
|
+
T_GroupAccessKey.AccessKeyCD, T_GroupAccessKey.AccessKeyKind, T_GroupAccessKey.AccessKey,
|
28
|
+
T_GroupAccessKey.ApprovalFlag, T_GroupAccessKey.UpdateName, T_GroupAccessKey.UpdateDate,
|
29
|
+
T_Group.DispatchKbn FROM T_GroupAccessKey
|
30
|
+
LEFT JOIN T_Group ON (T_GroupAccessKey.BranchNo = T_Group.BranchNo) AND
|
31
|
+
(T_GroupAccessKey.GroupID = T_Group.GroupID) WHERE (((T_Group.DispatchKbn)<>''))"
|
32
|
+
**ここまで**
|
33
|
+
**----------------------------------------------**
|
27
34
|
|
28
|
-
|
29
|
-
|
30
|
-
|
31
|
-
|
32
|
-
' & " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _
|
33
|
-
' & " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _
|
34
|
-
' & " AND AccessKeyKind = '1'"
|
35
|
-
' & " AND AccessKeyCD = '28' AND AccessKeyKind = '1'"
|
36
|
-
'-----------------------------------------------
|
37
|
-
'----------------------------------------------
|
38
|
-
'ここから追加
|
35
|
+
**---- MS SQLServer側(団体アクセスキーテーブル)**
|
36
|
+
**SQLの作成**
|
37
|
+
**-----------------------------------------------**
|
38
|
+
**ここから追加**
|
39
39
|
strSQLCheck = " select * from strDis " _
|
40
40
|
& " where CONCAT(GroupId,BranchNo) = '" & strCheckNoUketukeUpSakiAll(intArray) & "'" _
|
41
|
-
& " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod
|
41
|
+
& " AND AccessKeyCD = (select AccessKeyCD from M_AccessKeyPeriod
|
42
|
+
where CONVERT(varchar,current_timestamp,112)
|
43
|
+
between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _
|
42
44
|
& " AND AccessKeyKind = '1'"
|
43
|
-
|
45
|
+
**ここまで**
|
44
|
-
|
46
|
+
**----------------------------------------------**
|
45
|
-
|
46
|
-
|
47
|
+
**レコードセットを取得**
|
47
48
|
adoRsPass.Open strSQLCheck, adoConCheck, adOpenStatic, adLockReadOnly
|
48
49
|
|
49
|
-
|
50
|
+
**---- Oracle 側(団体情報マスタ)**
|
50
|
-
|
51
|
+
**SQLの作成**
|
51
52
|
strSQLWeb = "select * from S20 where DANTAINO = '" & strCheckNoUketukeUpSakiAll(intArray) & "'"
|
52
53
|
|
53
|
-
|
54
|
+
**レコードセットを取得**
|
54
55
|
adoRsWeb.Open strSQLWeb, adoConWeb, adOpenStatic, adLockReadOnly
|
55
56
|
|
56
|
-
|
57
|
+
**T_GroupAccessKey、S20 双方のパスワードを突合せ**
|
57
58
|
|
58
|
-
|
59
|
+
**判定フラグ(パスワード一致=1)**
|
59
60
|
hanteiFlg = 0
|
60
61
|
Do While Not adoRsPass.EOF
|
61
62
|
|
@@ -76,11 +77,11 @@
|
|
76
77
|
|
77
78
|
Loop
|
78
79
|
|
79
|
-
|
80
|
+
**レコードセットを閉じる**
|
80
81
|
adoRsPass.Close
|
81
82
|
adoRsWeb.Close
|
82
83
|
|
83
|
-
|
84
|
+
**パスワードが一致した場合**
|
84
85
|
If hanteiFlg = 1 Then
|
85
86
|
|
86
87
|
Sheets("ツール").Cells(intArray + StartRowNo, ColUmu).Value = "エラー無"
|
@@ -113,7 +114,7 @@
|
|
113
114
|
.Calculation = xlCalculationAutomatic
|
114
115
|
End With
|
115
116
|
|
116
|
-
|
117
|
+
**DBの切断**
|
117
118
|
DBDisConnectUketuke
|
118
119
|
DBDisConnectWeb
|
119
120
|
|