Option Compare Database
Option Explicit
Private Sub コマンド0_Click()
On Error GoTo ErrHandler
Dim adoCn As ADODB.Connection
Dim adoRs As ADODB.Recordset
Dim strSql As String
Dim strCSVFilePath As String
Dim intFNo As Integer
strCSVFilePath = Application.CurrentProject.Path & "\TEST.csv"
intFNo = FreeFile '使用可能なファイル番号を取得
Open strCSVFilePath For Output As #intFNo 'フルパスを指定してCSVファイルをオープン
'接続
Set adoCn = CurrentProject.Connection
'レコードセットを取得
Set adoRs = New ADODB.Recordset
strSql = "SELECT"
strSql = strSql & " T_精算書W.請求先,"
strSql = strSql & " SUM(T_精算書明細W.請求金額) AS 請求金額の合計"
strSql = strSql & " FROM"
strSql = strSql & " T_精算書W"
strSql = strSql & " INNER JOIN"
strSql = strSql & " T_精算書明細W"
strSql = strSql & " ON T_精算書W.REFNO = T_精算書明細W.REFNO"
strSql = strSql & " GROUP BY"
strSql = strSql & " T_精算書W.請求先"
strSql = strSql & " HAVING SUM(T_精算書明細W.請求金額) <> 0"
strSql = strSql & " ORDER BY"
strSql = strSql & " T_精算書W.請求先"
adoRs.Open strSql, adoCn, adOpenKeyset, adLockOptimistic
'CSV出力
Do Until adoRs.EOF
Write #intFNo, adoRs!請求先, adoRs!請求金額の合計
'Debug.Print adoRs!請求先, adoRs!請求金額の合計
adoRs.MoveNext
Loop
'終了
'CSVファイルをクローズ
Close #intFNo 'CSVファイルをクローズ
'ADOクローズと解放
adoRs.Close: Set adoRs = Nothing
adoCn.Close: Set adoCn = Nothing
MsgBox "END"
ExitSub:
Exit Sub
ErrHandler:
'CSVファイルをクローズ
Close #intFNo
'ADO解放
If Not adoRs Is Nothing Then
'ADOクローズ
If adoRs.State <> adStateClosed Then
adoRs.Close
End If
Set adoRs = Nothing
End If
If Not adoCn Is Nothing Then
'ADOクローズ
If adoCn.State <> adStateClosed Then
adoCn.Close
End If
Set adoCn = Nothing
End If
'エラーメッセージ
MsgBox ("Error No =" & Err.Number & vbCr & "Error Msg=" & Err.Description)
Resume ExitSub
End Sub