選択クエリの作成Logic

AccessVBA　備忘録

Sub ChangeQuery()

'記述場所：モジュール「AddressBookModule」

On Error GoTo Err_Process

Call Table_Open

Dim tq As QueryDef
Dim strOuttable As String
Dim strOutfile As String
Dim strIntable As String
Dim strIntfile As String
Dim strJoukenn(5) As String
Dim strMaruigai As String


strMaruigai = Me.丸福以外抽出

strOuttable = "T_台帳印刷wk"
strOutfile = "INTO " & strOuttable & " "
strIntable = "T_検査諸費用台帳"
strIntfile = "FROM " & strIntable & " "
strJoukenn(1) = "(T_検査諸費用台帳.受付日)>=[forms]![F_検査台帳印刷]![From日付] And (T_検査諸費用台帳.受付日)<=[forms]![F_検査台帳印刷]![To日付])"
If strMaruigai = "on" Then
strJoukenn(2) = "((T_検査諸費用台帳.得意先名) Not Like '*丸福*')"
Else
strJoukenn(2) = "((T_検査諸費用台帳.得意先名) Like [forms]![F_検査台帳印刷]![丸福抽出])"
End If
strJoukenn(3) = "((T_検査諸費用台帳.未収額)<>[forms]![F_検査台帳印刷]![金額条件])"



Set tq = Db.CreateQueryDef("Q_台帳印刷Data抽出", _
"SELECT T_検査諸費用台帳.ID, T_検査諸費用台帳.受付日, T_検査諸費用台帳.処理日, T_検査諸費用台帳.得ID, " & _
"T_検査諸費用台帳.得C, T_検査諸費用台帳.丸福, T_検査諸費用台帳.得ヨミ, T_検査諸費用台帳.得意先名, " & _
"T_検査諸費用台帳.得意先名2, T_検査諸費用台帳.車番, T_検査諸費用台帳.登録地, T_検査諸費用台帳.車種, " & _
"T_検査諸費用台帳.車番かな, T_検査諸費用台帳.車番2, T_検査諸費用台帳.車名, T_検査諸費用台帳.代行料, " & _
"T_検査諸費用台帳.[その他(課税)1], T_検査諸費用台帳.[その他(課税)2], T_検査諸費用台帳.[その他(課税)3], " & _
"T_検査諸費用台帳.消費税, T_検査諸費用台帳.自賠責, T_検査諸費用台帳.重量税, T_検査諸費用台帳.印紙代," & _
"T_検査諸費用台帳.[その他(非課税)1], T_検査諸費用台帳.[その他(非課税)2], T_検査諸費用台帳.合計, " & _
"T_検査諸費用台帳.入金1, T_検査諸費用台帳.入金日1, T_検査諸費用台帳.入金2, T_検査諸費用台帳.入金日2, " & _
"T_検査諸費用台帳.入金3, T_検査諸費用台帳.入金日3, T_検査諸費用台帳.入金計, T_検査諸費用台帳.未収額, " & _
"T_検査諸費用台帳.備考欄 " & _
"INTO T_台帳印刷wk " & _
"WHERE (" & strJoukenn(1) & " AND " & strJoukenn(2) & " AND " & strJoukenn(3) & ";")

'strOutfile & strIntfile & _


Call Table_Close

DoCmd.SetWarnings False '警告 Off
DoCmd.OpenQuery "Q_台帳印刷Data抽出", acViewNormal, acEdit
DoCmd.SetWarnings True '警告 On

Exit Sub

Err_Process:

If Err.Number = 3012 Then ' ----- クエリーが存在している場合
Db.QueryDefs.Delete "Q_台帳印刷Data抽出"
Else
' ----- それ以外のエラーは、内容を表示し強制終了
Debug.Print Err.Number
Debug.Print Err.Description
MsgBox "クエリー創成処理でエラーが発生しました" & vbCrLf & _
"エラー番号 : " & Err.Number & vbCrLf & _
"エラー詳細 : " & Err.Description
End '強制終了
End If

Resume

End Sub