アクセス小僧:VBAでクエリを変更 [コンピューター]
医療費を集計するデータベースにおいて、月ごとの医療費を集計するためのクエリの抽出条件が、
SQLのHAVING句で次の様に指定されているとします。
HAVING (((T_医療費.日付)>=#7/1/2017# And (T_医療費.日付)<#8/1/2017#))
このSQLで指定されている2つの日付(#7/1/2017#, #8/1/2017#)を変更するマクロを
作ってみました。SQLから日付部分を検索するために次の正規表現を使いました。
以下にマクロを示します。
Private Sub Agg_yyyy_mm(myQuery1 As String, YYYY1 As Integer, MM1 As Integer _
, YYYY2 As Integer, MM2 As Integer)
' 【機能】クエリで集計する年月を変更
' 【引数】
' myQuery1 as String : クエリ名
' YYYY1, YYYY2 as Integer : 年
' MM1, MM2 as Integer : 月
' 【変数】
Dim dbs As Database
Dim qdf As QueryDef
Dim strSQL As String
Dim reg As Object
Dim rep, v1, v2 As String
' 【コード】
Set dbs = CurrentDb ' カレントデータベース
Set qdf = dbs.QueryDefs(myQuery1) ' クエリ
' クエリの現在のSQL文を変数にセット
strSQL = qdf.SQL
' 正規表現オブジェクト作成
Set reg = CreateObject("VBScript.RegExp")
' 正規表現による置換(1)
' パターン=「>=#1/1/2017#」
v2 = ">=#" & MM1 & "/1/" & YYYY1 & "#"
With reg
.pattern = ">=#[0-9]*/[0-9]*/[0-9]*#" 'パターンを設定
.IgnoreCase = True '大文字と小文字を区別するFalseか、しないTrueか
.Global = True '文字列全体を検索するTrueか、しないFalseか
rep = .Replace(strSQL, v2) ' 置換
End With
' 正規表現による置換(2)
' パターン=「<#2/1/2017#」
v2 = "<#" & MM2 & "/1/" & YYYY2 & "#"
With reg
.pattern = "<#[0-9]*/[0-9]*/[0-9]*#" 'パターンを設定
.IgnoreCase = True '大文字と小文字を区別するFalseか、しないTrueか
.Global = True '文字列全体を検索するTrueか、しないFalseか
rep = .Replace(rep, v2) ' 置換
End With
' クエリのSQL文を変更
qdf.SQL = rep
' 解放
Set qdf = Nothing
Set dbs = Nothing
If Application.SysCmd(acSysCmdGetObjectState, acQuery, myQuery1) <> 0 Then
' クエリが開いていたら、開きなおす
DoCmd.Close acQuery, myQuery1, acSavePrompt
DoCmd.OpenQuery myQuery1
Else
' クエリが開いていなかったら、開く
DoCmd.OpenQuery myQuery1
End If
End Sub
SQLのHAVING句で次の様に指定されているとします。
HAVING (((T_医療費.日付)>=#7/1/2017# And (T_医療費.日付)<#8/1/2017#))
このSQLで指定されている2つの日付(#7/1/2017#, #8/1/2017#)を変更するマクロを
作ってみました。SQLから日付部分を検索するために次の正規表現を使いました。
日付 | 正規表現 |
>=#7/1/2017# | >=#[0-9]*/[0-9]*/[0-9]*# |
<#8/1/2017# | <#[0-9]*/[0-9]*/[0-9]*# |
以下にマクロを示します。
Private Sub Agg_yyyy_mm(myQuery1 As String, YYYY1 As Integer, MM1 As Integer _
, YYYY2 As Integer, MM2 As Integer)
' 【機能】クエリで集計する年月を変更
' 【引数】
' myQuery1 as String : クエリ名
' YYYY1, YYYY2 as Integer : 年
' MM1, MM2 as Integer : 月
' 【変数】
Dim dbs As Database
Dim qdf As QueryDef
Dim strSQL As String
Dim reg As Object
Dim rep, v1, v2 As String
' 【コード】
Set dbs = CurrentDb ' カレントデータベース
Set qdf = dbs.QueryDefs(myQuery1) ' クエリ
' クエリの現在のSQL文を変数にセット
strSQL = qdf.SQL
' 正規表現オブジェクト作成
Set reg = CreateObject("VBScript.RegExp")
' 正規表現による置換(1)
' パターン=「>=#1/1/2017#」
v2 = ">=#" & MM1 & "/1/" & YYYY1 & "#"
With reg
.pattern = ">=#[0-9]*/[0-9]*/[0-9]*#" 'パターンを設定
.IgnoreCase = True '大文字と小文字を区別するFalseか、しないTrueか
.Global = True '文字列全体を検索するTrueか、しないFalseか
rep = .Replace(strSQL, v2) ' 置換
End With
' 正規表現による置換(2)
' パターン=「<#2/1/2017#」
v2 = "<#" & MM2 & "/1/" & YYYY2 & "#"
With reg
.pattern = "<#[0-9]*/[0-9]*/[0-9]*#" 'パターンを設定
.IgnoreCase = True '大文字と小文字を区別するFalseか、しないTrueか
.Global = True '文字列全体を検索するTrueか、しないFalseか
rep = .Replace(rep, v2) ' 置換
End With
' クエリのSQL文を変更
qdf.SQL = rep
' 解放
Set qdf = Nothing
Set dbs = Nothing
If Application.SysCmd(acSysCmdGetObjectState, acQuery, myQuery1) <> 0 Then
' クエリが開いていたら、開きなおす
DoCmd.Close acQuery, myQuery1, acSavePrompt
DoCmd.OpenQuery myQuery1
Else
' クエリが開いていなかったら、開く
DoCmd.OpenQuery myQuery1
End If
End Sub
ヤバイぜ! ありがとうございます[__猫]
by cheese999 (2017-08-17 06:03)