Access开发平台--通用附件管理/删除附件功能代码

时　间:2016-03-21 12:30:01
作　者:杜超   ID：16058  城市：江阴
摘　要:如下图在删除按钮中要实现连同附件一起删除，要在删除事件里加Kill函数
正　文:

Public Sub btnDelete_Click()
    On Error GoTo ErrorHandler
    Dim strMsg As String
    Dim strPath As String
    Dim strSQL As String
    Dim strFile As String
    Dim FSO As Object
    Dim rs As DAO.Recordset
    If Me.sfrList.Form.CurrentRecord < 1 Then
        Exit Sub
    End If

    Me.sfrList.SetFocus
    RunCommand acCmdSelectRecord

    strMsg = "确定要连同相应附件一起删除？"
    If MsgBoxEx(strMsg, vbQuestion + vbOKCancel) = vbCancel Then
        Exit Sub
    End If

    strPath = GetParameter("Attachment Path", dbText, "", , , True)
    If Len(Nz(strPath)) = 0 Then strPath = CurrentProject.Path & "\Attachments\"
    If Left(strPath, 2) = ".\" Then strPath = CurrentProject.Path & Mid(strPath, 2)
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

    strSQL = "Select * FROM Sys_Attachments Where DataID='" & Me.sfrList![客户ID] & "'"
    Set rs = CurrentDb.OpenRecordset(strSQL)
    Do Until rs.EOF

        strFile = strPath & "\" & rs!AttachmentName
        Debug.Print strFile
        If Dir(strFile) <> "" Then
            Set FSO = CreateObject("Scripting.FileSystemObject")
            If FSO.FileExists(strFile) = True Then   '检测是否存在文件有则删除
                Kill strFile   '删除文件
            End If
            Set FSO = Nothing
        End If
        rs.MoveNext

    Loop
    DAORunSQL "delete * FROM Sys_Attachments Where DataID='" & Me.sfrList![客户ID] & "'"
    rs.Close
    Set rs = Nothing

    DAORunSQL "Delete FROM [客户信息表] Where [客户ID]=" & Nz(Me.sfrList![客户ID], 0)
    Me.RefreshDataList
    Me.btnDelete.SetFocus

ExitHere:
    Exit Sub

ErrorHandler:
    RDPErrorHandler Me.Name & ": Sub btnDelete_Click()"
    Resume ExitHere
End Sub