タイトルの通り、select文の取得結果をtsvファイルで出力し、任意の場所に保存したいと考えています。
DBとの接続環境が現在ないため、インターネットで調べながらスクリプトを考えておりますが、以下のようなスクリプトで実現できるでしょうか?
よろしければ、知恵を貸していただきたく思います。
どうぞよろしくお願いいたします。
Private Sub CommandButton2_Click() FolderName = Application.GetSaveAsFilename(FileFilter:="tsvファイル,*.tsv") 'DBの接続情報を書く(省略) 'ファイルを書き込みで開く(無ければ新規作成される、あれば上書き) Open "C:" & Format(Date, "yyyymmdd") & ".tsv" For Output As #1 '開いたファイルにselect文の実行結果を書きこむ ' print #1, select * from A '開いたファイルを閉じる Close #1 '終わったのが分かるようにメッセージを出す MsgBox "完了!" End Sub
追記
追加でいろいろ調査をしていたところ、Recodesetを利用することで実現ができそうな感じでした。
Option Explicit Call Main() Sub Main() Dim objCon Dim query Dim objRS Dim srvName, dbName, loginName, loginPass Dim objFS 'TSV出力で使用するオブジェクト変数 Dim TsvFileFullName 'TSVファイルの出力先※ファイル名を含むフルパス Dim objOutputTsv 'TSVの書き込みで使用するオブジェクト変数 'データベース接続情報を定義します。' srvName = "DBサーバ名" dbName = "DB名" loginName = "DBユーザ名" loginPass = "DBパスワード" 'TSVの出力先を任意で選べるようにする TsvFileFullName = ActiveWorkbook.Path & "\data.txt" 'SQLServerへ接続します。*************************************************************************************************** On Error Resume Next Set objCon = CreateObject("ADODB.Connection") objCon.Open "Driver={SQL Server}; server=" & srvName & "; database=" & dbName & "; uid=" & loginName & "; pwd=" & loginPass & ";" 'エラー処理' If Err.Number <> 0 Then Msgbox("エラーが発生しました。 " & " エラーナンバー:" & Err.Number & " エラー詳細:" & Err.Description) Set objCon = Nothing Exit Sub End If Err.Clear On Error Goto 0 'SQLを実行してレコードセットに格納します。********************************************************************************* query = "" query = query & "SELECT " query = query & " カラム1 " query = query & " ,カラム2 " query = query & " ,カラム3 " query = query & "FROM テーブル名 " query = query & "WHERE " query = query & " カラム1 = xx" On Error Resume Next '定義したSQLを実行してレコードセットに格納します。' Set objRS = objCon.Execute(query) 'エラー処理' If Err.Number <> 0 Then Msgbox("エラーが発生しました。 " & " エラーナンバー:" & Err.Number & " エラー詳細:" & Err.Description) objCon.Close Set objRS = Nothing Set objCon = Nothing Exit Sub End If Err.Clear On Error Goto 0 'レコードセットのデータを表示します。*************************************************************************************** On Error Resume Next 'レコードセットのデータ件数が0件の場合は処理を終了します。 If objRS.EOF Then Msgbox("対象データが存在しない為、処理を終了します。") objCon.Close Set objRS = Nothing Set objCon = Nothing Exit Sub End If 'FileSystemObjectを生成します。 Set objFS = CreateObject("Scripting.FileSystemObject") '空のTSVファイルを作成します。 objFS.CreateTextFile TsvFileFullName, True 'TSVファイルを開いてデータを書き込める状態にします。引数2の2は上書き可の指定、Trueはファイルがパスに存在しなければ新規作成 Set objOutputTsv = objFS.OpenTextFile(TsvFileFullName, 2, True) 'レコードセットの行数分ループします。 Do Until objRS.EOF '一行ずつレコードセットのデータをTSVファイルに書き込みます。 objOutputCsv.WriteLine objRS("カラム1").Value & "," & objRS("カラム2").Value & "," & objRS("カラム3").Value '次のレコードセットに移動します。 objRS.MoveNext Loop 'エラー処理' If Err.Number <> 0 Then Msgbox("エラーが発生しました。 " & " エラーナンバー:" & Err.Number & " エラー詳細:" & Err.Description) objCon.Close Set objRS = Nothing Set objCon = Nothing Set objFS = Nothing objOutputTsv.lose '開いたTSVファイルを閉じます。 Set objOutputCsv = Nothing Exit Sub End If Err.Clear On Error Goto 0 '終了処理をします。。******************************************************************************************************* 'オブジェクトを破棄します。 objCon.Close Set objRS = Nothing Set objCon = Nothing Set objFS = Nothing objOutputTsv.Close '開いたTSVファイルを閉じます。 Set objOutputCsv = Nothing End Sub
あなたの回答
tips
プレビュー