全レコード削除
全レコード削除を行います。　　引数：確認メッセージの有無・テーブル名 
Function FDeleteALLRecordSQL(myjmsg, myZDelDataTBL)

''全レコード 削除                      確認 1:有  2:無     2003/5/8
'    FDeleteALLRecordSQL 1,myZDelDataTBL

    Dim myCmdDelete As New ADODB.Command
    
    Dim myRetMsg As Integer
    Dim myTitle1 As String, myMsg1 As String, myMsg2 As String
    Dim myZ00 As String
    Dim myZNo As Long
    
    myTitle1 = "全レコード削除の確認"
    myMsg1 = myZDelDataTBL & " の 全レコードを削除しますか。？  "
    myMsg2 = "最適化をしてから、レコードを追加して下さい。  "

On Error GoTo DelRec_Err

''取得 レコードセットのレコード件数          2003/4/19
    myZNo = FDataCount01(myZDelDataTBL)

    If myZNo = 0 Then
'        MsgBox "レコード件数  ゼロ  "
        Exit Function
    End If
    
''Commandオブジェクトの操作対象をカレントデータベースに設定
    myCmdDelete.ActiveConnection = CurrentProject.Connection

''SQLステートメント作成
    myZ00 = "DELETE FROM " & myZDelDataTBL & ";"
    
''SQLステートメントをコマンドテキストに設定
    myCmdDelete.CommandText = myZ00

''コマンドを実行して レコード削除
    ''確認 無
    If myjmsg = 2 Then
        myCmdDelete.Execute
        Exit Function
    End If
    
    ''確認 有
    DoCmd.OpenTable myZDelDataTBL, acNormal, acEdit
    myRetMsg = MsgBox(myMsg1, vbYesNoCancel + vbExclamation, myTitle1)
    DoCmd.Close acTable, myZDelDataTBL

    Select Case myRetMsg
        Case vbYes
            FDeleteALLRecordSQL = 1
            myCmdDelete.Execute
        Case vbNo
            FDeleteALLRecordSQL = 2
        Case vbCancel
            FDeleteALLRecordSQL = 3
    End Select
    
    Exit Function

DelRec_Err:
    ''エラーメッセージ
    SErrMsgCom02
    End
    
End Function

Function FDataCount01(myRSource)

''取得 レコードセットのレコード件数 (テーブル,クエリ)         2003/4/24
'    myzno=FDataCount01 (mypTBLname)
    
    Dim myZmsg1 As String
    Dim myRecTemp As New ADODB.Recordset
    
    myRecTemp.Open myRSource, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    
    FDataCount01 = myRecTemp.RecordCount
    myRecTemp.Close
    
'    myZmsg1 = myRsource & " レコード数は " & myRecTemp.RecordCount
'    MsgBox myZmsg1
End Function

Sub SErrMsgCom02()

''エラーメッセージ
'    SErrMsgCom02

    Dim myZemsg2 As String, myZemsg3 As String
    
'    myZemsg1 = myZemsg1 & vbNewLine & vbNewLine
    myZemsg2 = "ErrNo [ " & Err.Number & " ]" & vbNewLine
    myZemsg3 = "理由 : " & Err.Description
    myZemsg3 = myZemsg2 & myZemsg3
    MsgBox myZemsg3, vbExclamation
    
End Sub
top