Access2010のフィルタープロパティ？
環境：WIN7(32bit）Access2010
以下にVBAをのせさせていただいておりますが、レポートのプロパティで条件を絞込みして、コード毎に、PDFに出力して、FAX(Windows)送信したいのですが、(ただしPDF出力はこだわっておりません。
Filterの位置が悪いのか、使い方が悪いのか、絞込みができておらず、全データーが出てきてしまっています。
どなたか、教えていただけないでしょうか？
’ここから印刷関係
On Error Resume Next
'レコードセット(T_工場マスタ)の準備
rs.Open "select*from T_工場名マスタ " + "where 工場コード between'" & Me![開始コード] & "' and '" & Me![終了コード] & "'" & "order by 工場コード", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'送信処理件数をクリア
送信処理件数 = 0
If Not rs.EOF Then
Do While Not rs.EOF
strWhere = "([工場コード] = '" & rs![工場コード] & "')" & " And ([伝票日付] BETWEEN '" & G_開始西暦 & "' And '" & G_終了西暦 & "')"
'送信要求件数の確認
vRet = DCount("*", "Q_工場別明細表", strWhere)
' If vRet = 0 Then
' Beep
' MsgBox "送信するものはありません", vbOKOnly + vbCritical
' Exit Sub
' End If
If Val(vRet) <> 0 Then
'送信情報を設定
wイメージファイル名 = SFW_Dir & "\売上" & rs.Fields("工場コード").Value & "_" & Format(Date, "mmdd")
w相手先 = "売上明細表(" & Trim(rs![工場名]) & ")"
wFAX番号 = ""
wFAX_N = 1
Do While wFAX_N <= Len(rs.Fields("FAX番号"))
If IsNumeric(Mid(rs.Fields("FAX番号"), wFAX_N, 1)) Then
wFAX番号 = wFAX番号 & Mid(rs.Fields("FAX番号"), wFAX_N, 1)
End If
wFAX_N = wFAX_N + 1
Loop
'相手先1件分のFAX文書を・・・・
With R_工場別明細表FAX
.Filter = strWhere ←ここで絞り込み(工場コード毎) でもFilter機能していない？strWhereには1件目のコードと日付範囲がちゃんとセットされている
.FilterOn = True
End With
DoCmd.OutputTo acReport, "R_工場別明細表FAX", acFormatPDF, wイメージファイル名 & ".PDF", False
Set W_FaxServer = CreateObject("FaxServer.FaxServer")
W_FaxServer.Connect CreateObject("WScript.Network").ComputerName
Set W_FaxDoc = W_FaxServer.CreateDocument("FaxDocument")
W_FaxDoc.FileName = wイメージファイル名 & ".PDF"
W_FaxDoc.FaxNumber = wFAX番号
' Call W_FaxDoc.Send
Call W_FaxServer.Disconnect
Set W_FaxServer = Nothing
Me!FilterOn = False
Me!FilterOnLoad = False
strWhere = ""
R_工場別明細表FAX.Filter = ""
'------Faxの送信を要求------------------------------------------------ここまで
rs.Fields("リターンコード").Value = 0
rs.Update
Else
rs.Fields("リターンコード").Value = "無" & "/" & Format(Date, "mmdd") & "_" & Format(Time(), "hhnnss")
rs.Update
End If
DoCmd.Close acReport, "R_工場別明細表FAX"
rs.MoveNext
Loop
'レコードセット(送信ヘッダー）を閉じる
Else
MsgBox "工場データが見つかりません！", 48, "管理システム"
End If
rs.Close
Set rs = Nothing
MsgBox "全てのＦＡＸ送信指示は通信マネージャに渡りました。", vbOKOnly + vbInformation
'CSVへ送信履歴を出力させる
DoCmd.TransferText acExportDelim, , "T_工場名マスタ", "d:\****\売上" & "/" & Format(Date, "mmdd") & "_" & Format(Time(), "hhnnss") & ".csv", True
Exit_Func6Push:
Exit Sub
Err_Func6Push:
Resume Exit_Func6Push
End Sub
お礼
御指摘のとおり、直してみたところ 無事書き込まれました。 ありがとうございました。助かりました。