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

回答No.1

hatena1989 · ベストアンサー

まず、本題以外から。

開発中は、On Error Resume Next の行はコメントアウトしましょう。

それで実行するとエラーがいっぱい出ると思います。そのエラーが出るコードを1つずつ修正してエラーに出ないようにします。
エラーが出ず実行できるようになったら、コメントアウトを外しましょう。

完成後も、できれば、On Error Resume Next ではなく、On Error Goto でちゃんとエラー処理するコードにしましょう。これはヘルプやWEB検索すればコード例は見つかります。

さて、本題ですが、

With R_工場別明細表FAX　　　
.Filter = strWhere　　　　　　　←ここで絞り込み(工場コード毎)　でもFilter機能していない？strWhereには1件目のコードと日付範囲がちゃんとセットされている
.FilterOn = True
End With

の部分、レポートを開かないとFilterは書けれません。開くときに、引数でFilterをかけるのが効率的でしょう。
上記のコードは削除して、下記を挿入してください。

DoCmd.OpenReport "R_工場別明細表FAX", acViewPreview, , strWhere

他にもエラーが出そうなところがありそうですが、とりあえずこれだけで。

お礼

早速のお答えありがとうございました。
おっしゃる通うまくできました。

＞他にもエラーが出そうなところがありそうですが、とりあえずこれだけで。

また、もしよろしければ、他にもエラーが出そうなところがありそうとのこと。
よろしければ、ご指摘いただけませんでしょうか？

回答No.2

hatena1989

On Error Resume Next を削除するか、コメントアウトすると、下記がエラーになると思います。

R_工場別明細表FAX.Filter = ""

お礼

ありがとうございました。

前回のご回答から、このレポートのプロパティーFilterに絞込み条件を入れない方法で、
きりぬけたので、この１文は削除してました。

いろいろありがとうございました。