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

質問編集履歴

1

追記

2021/06/25 23:12

投稿

ypk
ypk

スコア83

title CHANGED
File without changes
body CHANGED
@@ -32,4 +32,127 @@
32
32
 
33
33
 
34
34
  End Sub
35
+ ```
36
+
37
+
38
+ ### 追記
39
+
40
+ 追加でいろいろ調査をしていたところ、Recodesetを利用することで実現ができそうな感じでした。
41
+
42
+ ```ここに言語を入力
43
+ Option Explicit
44
+
45
+ Call Main()
46
+
47
+ Sub Main()
48
+
49
+ Dim objCon
50
+ Dim query
51
+ Dim objRS
52
+ Dim srvName, dbName, loginName, loginPass
53
+
54
+ Dim objFS 'TSV出力で使用するオブジェクト変数
55
+ Dim TsvFileFullName 'TSVファイルの出力先※ファイル名を含むフルパス
56
+ Dim objOutputTsv 'TSVの書き込みで使用するオブジェクト変数
57
+
58
+ 'データベース接続情報を定義します。'
59
+ srvName = "DBサーバ名"
60
+ dbName = "DB名"
61
+ loginName = "DBユーザ名"
62
+ loginPass = "DBパスワード"
63
+
64
+ 'TSVの出力先を任意で選べるようにする
65
+ TsvFileFullName = ActiveWorkbook.Path & "\data.txt"
66
+
67
+ 'SQLServerへ接続します。***************************************************************************************************
68
+ On Error Resume Next
69
+ Set objCon = CreateObject("ADODB.Connection")
70
+ objCon.Open "Driver={SQL Server}; server=" & srvName & "; database=" & dbName & "; uid=" & loginName & "; pwd=" & loginPass & ";"
71
+
72
+ 'エラー処理'
73
+ If Err.Number <> 0 Then
74
+ Msgbox("エラーが発生しました。  " & " エラーナンバー:" & Err.Number & " エラー詳細:" & Err.Description)
75
+ Set objCon = Nothing
76
+ Exit Sub
77
+ End If
78
+ Err.Clear
79
+ On Error Goto 0
80
+
81
+ 'SQLを実行してレコードセットに格納します。*********************************************************************************
82
+
83
+ query = ""
84
+ query = query & "SELECT "
85
+ query = query & " カラム1 "
86
+ query = query & " ,カラム2 "
87
+ query = query & " ,カラム3 "
88
+ query = query & "FROM テーブル名 "
89
+ query = query & "WHERE "
90
+ query = query & " カラム1 = xx"
91
+
92
+ On Error Resume Next
93
+ '定義したSQLを実行してレコードセットに格納します。'
94
+ Set objRS = objCon.Execute(query)
95
+
96
+ 'エラー処理'
97
+ If Err.Number <> 0 Then
98
+ Msgbox("エラーが発生しました。  " & " エラーナンバー:" & Err.Number & " エラー詳細:" & Err.Description)
99
+ objCon.Close
100
+ Set objRS = Nothing
101
+ Set objCon = Nothing
102
+ Exit Sub
103
+ End If
104
+ Err.Clear
105
+ On Error Goto 0
106
+
107
+ 'レコードセットのデータを表示します。***************************************************************************************
108
+ On Error Resume Next
109
+ 'レコードセットのデータ件数が0件の場合は処理を終了します。
110
+ If objRS.EOF Then
111
+ Msgbox("対象データが存在しない為、処理を終了します。")
112
+ objCon.Close
113
+ Set objRS = Nothing
114
+ Set objCon = Nothing
115
+ Exit Sub
116
+ End If
117
+
118
+ 'FileSystemObjectを生成します。
119
+ Set objFS = CreateObject("Scripting.FileSystemObject")
120
+ '空のTSVファイルを作成します。
121
+ objFS.CreateTextFile TsvFileFullName, True
122
+ 'TSVファイルを開いてデータを書き込める状態にします。引数2の2は上書き可の指定、Trueはファイルがパスに存在しなければ新規作成
123
+ Set objOutputTsv = objFS.OpenTextFile(TsvFileFullName, 2, True)
124
+ 'レコードセットの行数分ループします。
125
+ Do Until objRS.EOF
126
+ '一行ずつレコードセットのデータをTSVファイルに書き込みます。
127
+ objOutputCsv.WriteLine objRS("カラム1").Value & "," & objRS("カラム2").Value & "," & objRS("カラム3").Value
128
+ '次のレコードセットに移動します。
129
+ objRS.MoveNext
130
+ Loop
131
+
132
+ 'エラー処理'
133
+ If Err.Number <> 0 Then
134
+ Msgbox("エラーが発生しました。  " & " エラーナンバー:" & Err.Number & " エラー詳細:" & Err.Description)
135
+ objCon.Close
136
+ Set objRS = Nothing
137
+ Set objCon = Nothing
138
+
139
+ Set objFS = Nothing
140
+ objOutputTsv.lose '開いたTSVファイルを閉じます。
141
+ Set objOutputCsv = Nothing
142
+
143
+ Exit Sub
144
+ End If
145
+ Err.Clear
146
+ On Error Goto 0
147
+
148
+ '終了処理をします。。*******************************************************************************************************
149
+ 'オブジェクトを破棄します。
150
+ objCon.Close
151
+ Set objRS = Nothing
152
+ Set objCon = Nothing
153
+ Set objFS = Nothing
154
+ objOutputTsv.Close '開いたTSVファイルを閉じます。
155
+ Set objOutputCsv = Nothing
156
+
157
+ End Sub
35
158
  ```