Private Sub Command2_Click()
Dim Getfilename As String
   If Common1.filename <> vbNullString Then        con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Data\Status.mdb;Persist Security Info=False"
        con.Open
        
        con.CursorLocation = adUseClient       Set rs = con.Execute("insert into tb_Paths (filename,Paths) values('" & Common1.FileTitle & "', '" & Common1.filename & "')")
                con.Close
        MsgBox "数据保存成功", 64, "提示信息"    End If    Set con = Nothing
    Set rs = Nothing
End Sub这个代码是把文件名和路径一起存放到ACCESS的TB_Paths中,但是没有限制同名文件,一个文件能够写入N次,现在我想在里面加一个能够禁止同名文件反复加入的代码,有msgbox信息提示的,求各位大侠帮帮忙,谢谢了

解决方案 »

  1.   

    在数据库中把filename设为No Duplicates
      

  2.   


    FHPH = Replace(Trim(Text1.Text), "'", "''")         '入货票号 Set rs = New ADODB.Recordset
    strSql = "select * from Warehouse where INPUTVOTES='" & FHPH & "' "
    rs.Open strSql, conn, adOpenStatic, adLockReadOnlyIf rs.RecordCount <> 0 Then
        MsgBox "   ", 0 + 48, "  "
        rs.Close
    Text1.Text = ""
        Exit Sub
    End If
      

  3.   

     MsgBox " 名称已经存在,请重新输入  ", 0 + 48, " 提示 "
      

  4.   

    FHPH = Replace(Trim(Text1.Text), "'", "''")         '名称
     Set rs = New ADODB.Recordset
    strSql = "select * from 表 where 名称='" & FHPH & "' "
    rs.Open strSql, conn, adOpenStatic, adLockReadOnlyIf rs.RecordCount <> 0 Then
    MsgBox " 名称已经存在,请重新输入 ", 0 + 48, " 提示 "
    rs.Close
    Text1.Text = ""
        Exit Sub
    End If
      

  5.   

     Private Sub Command2_Click()
     Dim Getfilename As String
     Dim strSql AS string
      If Common1.filename <> vbNullString Then
     con.CursorLocation = adUseClient
      con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Data\Status.mdb;Persist Security Info=False"
      con.Open
        
     
    Set rss = New ADODB.Recordset
    strSql = "select * from tb_Paths where filename='" & Common1.FileTitle & "'"
    rss.Open strSql, con, adOpenStatic, adLockReadOnly
    if rss.recordcount > 0 then
    msgbox"用户已经存在,请重新输入",0 + 48 ,"提示"
    exit sub
    end if  Set rs = con.Execute("insert into tb_Paths (filename,Paths) values('" & Common1.FileTitle & "', '" & Common1.filename & "')")
          con.Close
      MsgBox "数据保存成功", 64, "提示信息"  End If  Set con = Nothing
      Set rs = Nothing
    End Sub