SSブログ

アクセス小僧:VBAでクエリを変更 [コンピューター]

医療費を集計するデータベースにおいて、月ごとの医療費を集計するためのクエリの抽出条件が、

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
ヤバイぜ!(4)  コメント(1) 
共通テーマ:blog

ヤバイぜ! 4

コメント 1

cheese999

ヤバイぜ! ありがとうございます[__猫]
by cheese999 (2017-08-17 06:03) 

コメントを書く

お名前:[必須]
URL:
コメント:
画像認証:
下の画像に表示されている文字(英大文字の「オー」、英小文字の「ユー」、アラビア数字の「ハチ」、アラビア数字の「イチ」、アラビア数字の「ニ」)を入力してください。

Facebook コメント

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。