1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
|
Dim i As Integer = 0
Dim strCnxSrc As String = "Data Source=localhost; Integrated
Security=SSPI; Initial Catalog=" & TxtBoxBdSrc.Text
Dim strCnxFnl As String = "Data Source=localhost; Integrated
Security=SSPI; Initial Catalog=" & TxtBoxBdFnl.Text
Dim strRequete As String = "SELECT * FROM " & TxtBoxTblSrc.Text
Dim RqtCreatTbl 'As String = ""
Dim RqtFillTbl 'As String = ""
Dim RqtRmpTbl 'As String = ""
Dim tmpRqtRmpTbl 'As String = ""
Dim RowNbr As Double = 0
Try
Dim CnxSrc As New SqlConnection(strCnxSrc)
Dim CmdSrc As New SqlCommand(strRequete, CnxSrc)
CnxSrc.Open()
Dim RdrSrc As SqlDataReader = CmdSrc.ExecuteReader()
Dim schema As Data.DataTable = RdrSrc.GetSchemaTable
'Elaboration de la requête pour créer la table de sauvegarde
suivant la structurede la table initiale
RqtCreatTbl = "CREATE TABLE " & TxtBoxTblFnl.Text & " ("
RqtFillTbl = "INSERT INTO " & TxtBoxTblFnl.Text & " ("
For Each myRow As Data.DataRow In schema.Rows
For Each myCol As Data.DataColumn In schema.Columns
If myCol.ColumnName = "ColumnSize" Then
RqtCreatTbl += myRow(0) & " " &
RdrSrc.GetDataTypeName(i).ToUpper
If RdrSrc.GetDataTypeName(i).ToUpper <> "SMALLINT"
And RdrSrc.GetDataTypeName(i).ToUpper <> "TINYINT" And
RdrSrc.GetDataTypeName(i).ToUpper <> "DATETIME" And
RdrSrc.GetDataTypeName(i).ToUpper <> "NTEXT" And
RdrSrc.GetDataTypeName(i).ToUpper <> "IMAGE" And
RdrSrc.GetDataTypeName(i).ToUpper <> "INT" And
RdrSrc.GetDataTypeName(i).ToUpper <> "MONEY" And
RdrSrc.GetDataTypeName(i).ToUpper <> "BIT" And
RdrSrc.GetDataTypeName(i).ToUpper <> "UNIQUEIDENTIFIER" Then
RqtCreatTbl += "(" & myRow(2) & ")"
End If
i += 1
RqtCreatTbl += ","
End If
Next
Next
RqtCreatTbl = Mid(RqtCreatTbl, 1, Len(RqtCreatTbl) - 1) & ")"
Label1.Text = "Creation de " & TxtBoxBdFnl.Text & " / " &
TxtBoxTblFnl.Text & " à partir de " & TxtBoxBdSrc.Text & " / " &
TxtBoxTblSrc.Text
TextBox2.Text = RqtCreatTbl
'Creation de la requête de remplissage de la nouvelle table
RqtRmpTbl = "INSERT INTO " & TxtBoxTblFnl.Text & " VALUES ("
i = 0
Do While RdrSrc.Read()
Do While i < RdrSrc.FieldCount
'Dim testvar = RdrSrc.GetDataTypeName(i).ToUpper
If RdrSrc.GetDataTypeName(i).ToUpper <> "MONEY" And
RdrSrc.GetDataTypeName(i).ToUpper <> "BIT" Then
RqtRmpTbl += "'" & Replace(RdrSrc.Item(i).ToString, "'",
"''") & "',"
Else
If RdrSrc.GetDataTypeName(i).ToUpper = "BIT" Then
'Dim tmpverif As String = RdrSrc.Item(i).ToString
If RdrSrc.Item(i).ToString = "0" Or RdrSrc.Item
(i).ToString = "NULL" Or RdrSrc.Item(i).ToString = "" Or RdrSrc.Item
(i).ToString = "False" Then
RqtRmpTbl += "0,"
Else
RqtRmpTbl += "1,"
End If
Else
RqtRmpTbl += Replace(Replace(RdrSrc.Item
(i).ToString, ",", "."), "'", "''") & ","
End If
End If
i += 1
Loop
i = 0
RqtRmpTbl = Mid(RqtRmpTbl, 1, Len(RqtRmpTbl) - 1) & ")
*+*+*+* INSERT INTO " & TxtBoxTblFnl.Text & " VALUES ("
RowNbr += 1
Loop
RdrSrc.Close()
CnxSrc.Close()
'Création de la table sur la deuxième base de données
Dim CnxFnl As New SqlConnection(strCnxFnl)
Dim CmdFnl As New SqlCommand(RqtCreatTbl, CnxFnl)
CnxFnl.Open()
Dim RdrFnl As SqlDataReader = CmdFnl.ExecuteReader()
RdrFnl.Close()
TextBox1.Text = RqtRmpTbl
'Remplissage de la nouvelle table
Dim Target As String = "*+*+*+*"
Do While i < RowNbr
tmpRqtRmpTbl = Mid(RqtRmpTbl, 1, InStr(RqtRmpTbl, Target) -
1)
RqtRmpTbl = Mid(RqtRmpTbl, InStr(RqtRmpTbl, Target) + 8,
RqtRmpTbl.Length)
Dim CmdRmp As New SqlCommand(tmpRqtRmpTbl, CnxFnl)
Dim RdrRmp As SqlDataReader = CmdRmp.ExecuteReader()
RdrRmp.Close()
i += 1
Loop
i = 0
CnxFnl.Close()
MsgBox("La copie de la table s'est bien déroulée.")
Catch e As Exception
MsgBox("L'erreur suivante a été rencontrée :" & Chr(13) & Chr
(13) & e.Message)
End Try |
Partager