質問するログイン新規登録

質問編集履歴

4

タグを変更

2018/05/10 08:12

投稿

bako
bako

スコア6

title CHANGED
File without changes
body CHANGED
File without changes

3

何度もすみません。使い方がよくわかってませんでした。```で括りました。

2018/05/10 08:12

投稿

bako
bako

スコア6

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
- **MS SQLServer側のレコードセットを定義**
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
- **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
- **----------------------------------------------**
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
- **---- MS SQLServer側(団体アクセスキーテーブル)**
36
- **SQLの作成**
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
- **---- Oracle 側(団体情報マスタ)**
95
+ '---- Oracle 側(団体情報マスタ)
51
- **SQLの作成**
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
- **T_GroupAccessKey、S20 双方のパスワードを突合せ**
102
+ 'T_GroupAccessKey、S20 双方のパスワードを突合せ
58
103
 
59
- **判定フラグ(パスワード一致=1)**
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
- **DBの切断**
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
- **MS SQLServer側のレコードセットを定義**
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
- If strCheckNoUketukeUpSakiAll(intArray) <> "" Then
182
+ If strCheckNoUketukeUpSakiAll(intArray) <> "" Then
136
183
 
137
184
 
138
- **---- MS SQLServer側(団体アクセスキーテーブル)**
185
+ '---- MS SQLServer側(団体アクセスキーテーブル)
139
- **SQLの作成**
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
- **MS SQLServer側のレコードセットを定義**
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
- **SQLの作成**
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
- **---- MS SQLServer側(団体アクセスキーテーブル)**
210
+ '---- MS SQLServer側(団体アクセスキーテーブル)
162
- **SQLの作成**
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を載せました。

2018/05/10 08:10

投稿

bako
bako

スコア6

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

使い方が分からずすみません。コメントアウトは太字にしました。コードは見やすいように改行しました。

2018/05/10 06:43

投稿

bako
bako

スコア6

title CHANGED
File without changes
body CHANGED
@@ -7,7 +7,9 @@
7
7
  既存のVBAに構文を追加したんですが、「実行時エラー'-2147217865(80040e37)':オートメーションエラーです。」のエラーが表示されます。
8
8
 
9
9
  ### 該当のソースコード
10
+ ```VBA
11
+ ```
10
- 'MS SQLServer側のレコードセットを定義
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
- 'SQLの作成
24
- 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)<>''))"
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
- '---- MS SQLServer側(団体アクセスキーテーブル)
29
- 'SQLの作成
30
- '-----------------------------------------------
31
- ' strSQLCheck = " select * from T_GroupAccessKey " _
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 where CONVERT(varchar,current_timestamp,112) between CONVERT(varchar,accesskeyfrom,112) and CONVERT(varchar,accesskeyto,112) )" _
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
- '---- Oracle 側(団体情報マスタ)
50
+ **---- Oracle 側(団体情報マスタ)**
50
- 'SQLの作成
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
- 'T_GroupAccessKey、S20 双方のパスワードを突合せ
57
+ **T_GroupAccessKey、S20 双方のパスワードを突合せ**
57
58
 
58
- '判定フラグ(パスワード一致=1)
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
- 'DBの切断
117
+ **DBの切断**
117
118
  DBDisConnectUketuke
118
119
  DBDisConnectWeb
119
120