Access2002のコンパイルエラーについて

質問

Access2002を使っていて、印刷ボタンを押したら、下記のような見たことのない画面になり、
「コンパイルエラー　end function が必要です。」というメッセージが出てきました。
どなたか詳しい方、修復の方法を教えて下さい。よろしくお願いします。

Private Function PfDataMake() As Boolean
'On Error GoTo Err_PfDataMake

Dim St_Sql As String
Dim Ln_Cnt As Long
Dim Rs_Cnt As Recordset
Dim Rs_Cnt2 As Recordset
Dim In_Cnt As Long
Dim End_Flg As Boolean
Dim Code1 As Long
Dim Gokei As Long
Dim Gohan As Long
Dim Okayu As Long
Dim Josyoku As Long
Dim Kizami As Long
Dim ChoKizami As Long
Dim GenEn As Long
Dim Kome As String
Dim Okazu As String
Dim Enbun As String
Dim Hiduke As Date
Dim Youbi As String

'W_発注食数合計の初期化
St_Sql = "Delete From W_発注食数合計 ;"
DoCmd.RunSQL (St_Sql)
'W_発注食数明細の初期化
St_Sql = "Delete From W_発注食数明細 ;"
DoCmd.RunSQL (St_Sql)

'///// 対象データを抽出 /////
St_Sql = "SELECT * "
St_Sql = St_Sql & "FROM W_配食入力 "
'/// 20060423追加 出力対象「前日キャンセル」追加 start ///
'St_Sql = St_Sql & "WHERE W_配食入力.キャンセル = 0"
'St_Sql = St_Sql & "WHERE (W_配食入力.キャンセル = 0) or (W_配食入力.キャンセル = 2)"
St_Sql = St_Sql & "WHERE (W_配食入力.配達 <> 3) and (W_配食入力.配達 <> 4)"
'/// 20060423追加 end ///
St_Sql = St_Sql & " ORDER BY W_配食入力.利用者コード ;"
'件数を取得
Set Rs_Cnt = CurrentDb.OpenRecordset(St_Sql)
Ln_Cnt = Rs_Cnt.RecordCount
End_Flg = False
'レコード無し判定
If Rs_Cnt.EOF = True Or Rs_Cnt.BOF = True Then
End_Flg = True
End If
Gokei = 0
Gohan = 0
Okayu = 0
Josyoku = 0
Kizami = 0
ChoKizami = 0
GenEn = 0

'ループ処理
Rs_Cnt.MoveFirst
Hiduke = Rs_Cnt("日付")
Youbi = Rs_Cnt("曜日")
Do Until Rs_Cnt.EOF = True
Gokei = Gokei + 1
Select Case Rs_Cnt("米")
Case 1
Gohan = Gohan + 1
Kome = " "
Case Else
Okayu = Okayu + 1
Kome = "おかゆ"
End Select
Select Case Rs_Cnt("おかず")
Case 1
Josyoku = Josyoku + 1
Okazu = " "
Case 2
Kizami = Kizami + 1
Okazu = "刻み"
Case Else
ChoKizami = ChoKizami + 1
Okazu = "超刻み"
End Select
Select Case Rs_Cnt("減塩")
Case 1
Enbun = " "
Case 2
GenEn = GenEn + 1
Enbun = "減塩"
End Select

Code1 = Rs_Cnt("利用者コード")
St_Sql = "SELECT D_利用者.シメイ "
St_Sql = St_Sql & "FROM D_利用者 "
St_Sql = St_Sql & "WHERE D_利用者.利用者コード = " & Code1
St_Sql = St_Sql & " ORDER BY D_利用者.利用者コード ;"
'件数を取得
Set Rs_Cnt2 = CurrentDb.OpenRecordset(St_Sql)
Ln_Cnt = Rs_Cnt2.RecordCount

St_Sql = "INSERT INTO W_発注食数明細 VALUES (" & Code1 & ","
St_Sql = St_Sql & "'" & Rs_Cnt("利用者氏名") & "','" & Rs_Cnt2("シメイ") & "',"
St_Sql = St_Sql & "'" & Rs_Cnt("主食") & "','" & Rs_Cnt("副食") & "',"
St_Sql = St_Sql & "'" & Kome & "','" & Okazu & "','" & Enbun & "'"
St_Sql = St_Sql & ") ;"

DoCmd.RunSQL (St_Sql)

Rs_Cnt.MoveNext

Loop

St_Sql = "INSERT INTO W_発注食数合計 VALUES ('" & Hiduke & "',"
St_Sql = St_Sql & "'" & Youbi & "'," & Gokei & "," & Gohan & "," & Okayu & ","
St_Sql = St_Sql & Josyoku & "," & Kizami & "," & ChoKizami & "," & GenEn
St_Sql = St_Sql & ") ;"

DoCmd.RunSQL (St_Sql)

'レコードセットの終了
Rs_Cnt.Close
Rs_Cnt2.Close

Exit Function
Err_PfDataMake:

Resume Next

回答No.1

bardfish · ベストアンサー

一番最後(resume nextの次)にEnd Functionを追加すればいいんじゃないの？

回答No.2

chie65536（@chie65535）

Accessのmdbファイルは、定期的に最適化をして、修復を行なわないと、マクロプログラムの一部が欠損して失われる場合があります。

ご質問のケースでは「元々の正常なプログラムが、どのようになっていたのか判らない」ので、簡単に「最後にend functionを付け足せば直る」とは言えません。

確かに「最後にend functionを付け足せばエラーは出なくなる」のは間違い無いですが「end functionの行だけが消えた」と言う保証はどこにもありません。もしかしたら「正常な動作に必要なマクロがゴッソリ消えている」のかも知れません。

「Visual Basic Editorが起動されてて、ウッカリと１行だけ消してしまった」というのは「普通は有り得ない」ですし、消してしまったら「気が付く」でしょう。

なので「定期的な最適化を行なっていないために、使っている最中にデータベースファイルが破損して、マクロプログラムがゴッソリ欠落した」という可能性が高いです。

もし「mdbファイルのバックアップを取ってない」場合は、もしかしたら「mdbファイルが絶望的な状態」なのかも知れません。「壊れる前のバックアップ」はありますか？