[vbnetvbnet]

.
منقول

دالة CopyTableToDatabase لنسخ بيانات جدول من قاعدة بيانات إلى أخرى بشرط وجود نفس الجدول والحقول بقاعدة البيانات الثانية

كود :

Private Function CopyTableToDatabase(ByVal tableName As String, ByVal fromDatabaseName As String, ByVal fromDatabasePassword As String, ByVal toDatabaseName As String, ByVal toDatabasePassword As String, Optional ByVal Access2007 As Boolean = False) As Boolean
    Try
        Dim provider As String = IIf(Access2007, "Microsoft.ACE.OLEDB.12.0", "Microsoft.Jet.OLEDB.4.0")
        Dim conFrom As New OleDb.OleDbConnection("Provider=" & provider & ";Data Source=" & fromDatabaseName & ";Jet OLEDB:Database Password=" & fromDatabasePassword & ";")
        Dim conTo As New OleDb.OleDbConnection("Provider=" & provider & ";Data Source=" & toDatabaseName & ";Jet OLEDB:Database Password=" & toDatabasePassword & ";")

        conTo.Open()
        Dim comTo As New OleDb.OleDbCommand("Delete from " & tableName, conTo)
        comTo.ExecuteNonQuery()
        conTo.Close()

        conFrom.Open()
        Dim comFrom As New OleDb.OleDbCommand("Insert into [" & toDatabaseName & ";PWD=" & IIf(toDatabasePassword = "", " ", toDatabasePassword) & "]." & tableName & " SELECT * From " & tableName, conFrom)
        comFrom.ExecuteNonQuery()
        conFrom.Close()

        Return True

    Catch ex As Exception
        MsgBox(ex.Message)
        Return False
    End Try
End Function

طريقة استخدامها

كود :

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    'If CopyTableToDatabase("Table1", Application.StartupPath & "\db1.mdb", "", Application.StartupPath & "\db2.mdb", "", False) Then
    If CopyTableToDatabase("Table1", Application.StartupPath & "\Database1.accdb", "", Application.StartupPath & "\Database1.accdb", "", True) Then
        MsgBox("تم النسخ بنجاح")
    Else
        MsgBox("فشلت عملية النسخ")
    End If

End Sub