質問編集履歴

1

追記

2021/06/25 23:12

投稿

ypk
ypk

スコア83

test CHANGED
File without changes
test CHANGED
@@ -67,3 +67,249 @@
67
67
  End Sub
68
68
 
69
69
  ```
70
+
71
+
72
+
73
+
74
+
75
+ ### 追記
76
+
77
+
78
+
79
+ 追加でいろいろ調査をしていたところ、Recodesetを利用することで実現ができそうな感じでした。
80
+
81
+
82
+
83
+ ```ここに言語を入力
84
+
85
+ Option Explicit
86
+
87
+
88
+
89
+ Call Main()
90
+
91
+
92
+
93
+ Sub Main()
94
+
95
+
96
+
97
+ Dim objCon
98
+
99
+ Dim query
100
+
101
+ Dim objRS
102
+
103
+ Dim srvName, dbName, loginName, loginPass
104
+
105
+
106
+
107
+ Dim objFS 'TSV出力で使用するオブジェクト変数
108
+
109
+ Dim TsvFileFullName 'TSVファイルの出力先※ファイル名を含むフルパス
110
+
111
+ Dim objOutputTsv 'TSVの書き込みで使用するオブジェクト変数
112
+
113
+
114
+
115
+ 'データベース接続情報を定義します。'
116
+
117
+ srvName = "DBサーバ名"
118
+
119
+ dbName = "DB名"
120
+
121
+ loginName = "DBユーザ名"
122
+
123
+ loginPass = "DBパスワード"
124
+
125
+
126
+
127
+ 'TSVの出力先を任意で選べるようにする
128
+
129
+ TsvFileFullName = ActiveWorkbook.Path & "\data.txt"
130
+
131
+
132
+
133
+ 'SQLServerへ接続します。***************************************************************************************************
134
+
135
+ On Error Resume Next
136
+
137
+ Set objCon = CreateObject("ADODB.Connection")
138
+
139
+ objCon.Open "Driver={SQL Server}; server=" & srvName & "; database=" & dbName & "; uid=" & loginName & "; pwd=" & loginPass & ";"
140
+
141
+
142
+
143
+ 'エラー処理'
144
+
145
+ If Err.Number <> 0 Then
146
+
147
+ Msgbox("エラーが発生しました。  " & " エラーナンバー:" & Err.Number & " エラー詳細:" & Err.Description)
148
+
149
+ Set objCon = Nothing
150
+
151
+ Exit Sub
152
+
153
+ End If
154
+
155
+ Err.Clear
156
+
157
+ On Error Goto 0
158
+
159
+
160
+
161
+ 'SQLを実行してレコードセットに格納します。*********************************************************************************
162
+
163
+
164
+
165
+ query = ""
166
+
167
+ query = query & "SELECT "
168
+
169
+ query = query & " カラム1 "
170
+
171
+ query = query & " ,カラム2 "
172
+
173
+ query = query & " ,カラム3 "
174
+
175
+ query = query & "FROM テーブル名 "
176
+
177
+ query = query & "WHERE "
178
+
179
+ query = query & " カラム1 = xx"
180
+
181
+
182
+
183
+ On Error Resume Next
184
+
185
+ '定義したSQLを実行してレコードセットに格納します。'
186
+
187
+ Set objRS = objCon.Execute(query)
188
+
189
+
190
+
191
+ 'エラー処理'
192
+
193
+ If Err.Number <> 0 Then
194
+
195
+ Msgbox("エラーが発生しました。  " & " エラーナンバー:" & Err.Number & " エラー詳細:" & Err.Description)
196
+
197
+ objCon.Close
198
+
199
+ Set objRS = Nothing
200
+
201
+ Set objCon = Nothing
202
+
203
+ Exit Sub
204
+
205
+ End If
206
+
207
+ Err.Clear
208
+
209
+ On Error Goto 0
210
+
211
+
212
+
213
+ 'レコードセットのデータを表示します。***************************************************************************************
214
+
215
+ On Error Resume Next
216
+
217
+ 'レコードセットのデータ件数が0件の場合は処理を終了します。
218
+
219
+ If objRS.EOF Then
220
+
221
+ Msgbox("対象データが存在しない為、処理を終了します。")
222
+
223
+ objCon.Close
224
+
225
+ Set objRS = Nothing
226
+
227
+ Set objCon = Nothing
228
+
229
+ Exit Sub
230
+
231
+ End If
232
+
233
+
234
+
235
+ 'FileSystemObjectを生成します。
236
+
237
+ Set objFS = CreateObject("Scripting.FileSystemObject")
238
+
239
+ '空のTSVファイルを作成します。
240
+
241
+ objFS.CreateTextFile TsvFileFullName, True
242
+
243
+ 'TSVファイルを開いてデータを書き込める状態にします。引数2の2は上書き可の指定、Trueはファイルがパスに存在しなければ新規作成
244
+
245
+ Set objOutputTsv = objFS.OpenTextFile(TsvFileFullName, 2, True)
246
+
247
+ 'レコードセットの行数分ループします。
248
+
249
+ Do Until objRS.EOF
250
+
251
+ '一行ずつレコードセットのデータをTSVファイルに書き込みます。
252
+
253
+ objOutputCsv.WriteLine objRS("カラム1").Value & "," & objRS("カラム2").Value & "," & objRS("カラム3").Value
254
+
255
+ '次のレコードセットに移動します。
256
+
257
+ objRS.MoveNext
258
+
259
+ Loop
260
+
261
+
262
+
263
+ 'エラー処理'
264
+
265
+ If Err.Number <> 0 Then
266
+
267
+ Msgbox("エラーが発生しました。  " & " エラーナンバー:" & Err.Number & " エラー詳細:" & Err.Description)
268
+
269
+ objCon.Close
270
+
271
+ Set objRS = Nothing
272
+
273
+ Set objCon = Nothing
274
+
275
+
276
+
277
+ Set objFS = Nothing
278
+
279
+ objOutputTsv.lose '開いたTSVファイルを閉じます。
280
+
281
+ Set objOutputCsv = Nothing
282
+
283
+
284
+
285
+ Exit Sub
286
+
287
+ End If
288
+
289
+ Err.Clear
290
+
291
+ On Error Goto 0
292
+
293
+
294
+
295
+ '終了処理をします。。*******************************************************************************************************
296
+
297
+ 'オブジェクトを破棄します。
298
+
299
+ objCon.Close
300
+
301
+ Set objRS = Nothing
302
+
303
+ Set objCon = Nothing
304
+
305
+ Set objFS = Nothing
306
+
307
+ objOutputTsv.Close '開いたTSVファイルを閉じます。
308
+
309
+ Set objOutputCsv = Nothing
310
+
311
+
312
+
313
+ End Sub
314
+
315
+ ```