Sección de códigos , trucos y ejemplos para visual basic

328 - Clonar tabla

Formulario que permite clonar una tabla utilizando Adox , Ado y Jro

vista del formulario para poder copiar y clonar tablas usando adox y jro

Primero se debe abrir la base de datos que ejecuta la Sub Abrir_Bd donde se debe pasar el path de la como parámetro que luego se asigna al Connectionstring

Abrir "Path de la bd"

Luego para clonar la tabla, se ejecuta la función Clonar que recibe como parámetro la conexión abierta anteriormente, el nombre de la tabla que se va clonar, el nuevo nombre de la tabla clonada, y el modo u opción ( Copiar solo la estructura o estructura y datos)

Call Clonar(cnn, "LaTabla", "TablaClon", ESTRUCTURA_DATOS o SOLO_ESTRUCTURA)

Para el ejemplo se debe añadir las siguientes referencias al proyecto

1 - Microsoft Activex data Objects ( Ado )

2 - Microsoft Ado Ext xx for dll and Security ( Adox )

3 - Microsoft Jet and replication Objects ( Jro )

Controles para el formulario

1 - Un textbox ( text1 ) para indicar la ruta de la base de datos

2 - Un textbox ( text2 ) para indicar el nombre de la tabla que se va a clonar

3 - Un textbox ( text3 ) para indicar el nombre que tendrá la tabla a clonar

4 - Un ComboBox ( Combo1 ) para la opción " Copiar solo estructura " y " Copiar Estructura y datos "

5 - Un Command1 para Clonar la tabla

6 - Un Command2 para abrir la conexión a la bd

Si la tabla a clonar ya existe en la bd, la misma no se reemplaza y la función genera error

Nota : en el siguiente enlace hay una clase que permite clonar tablas y campos, y un montón de otras funciones útiles : módulo para ado

Código fuente en el formulario

Option Explicit Private obj_JetEngine As JRO.JetEngine Private cnn As ADODB.Connection Enum E_Opcion ESTRUCTURA_DATOS = 0 SOLO_ESTRUCTURA = 1 End Enum Private Function Clonar(cnn As ADODB.Connection, _ ByVal Source_Table_Name As String, _ ByVal Dest_Table_Name As String, _ Opcion As E_Opcion) As Boolean On Error Resume Next Dim sIndex As String Dim o_Catalog As New ADOX.Catalog Dim i_Columns As Integer Dim i As Integer Dim ret As Boolean Dim o_Column As New ADOX.Column Dim obj_ADOX_Index As ADOX.Index While cnn.State = 5 DoEvents obj_JetEngine.RefreshCache cnn Wend Set o_Catalog.ActiveConnection = cnn If Opcion = ESTRUCTURA_DATOS Then ret = ADOExecute("Select [" & Source_Table_Name & _ "].* Into [" & Dest_Table_Name & "] From [" & Source_Table_Name & "];") ElseIf Opcion = SOLO_ESTRUCTURA Then ret = ADOExecute("Select [" & Source_Table_Name & _ "].* Into [" & Dest_Table_Name & "] From [" & Source_Table_Name & "];") ret = ADOExecute("Delete [" & Dest_Table_Name & _ "].* From [" & Dest_Table_Name & "];") End If i_Columns = o_Catalog.Tables(Source_Table_Name).Columns.Count - 1 Set o_Column.ParentCatalog = o_Catalog For i = 0 To i_Columns o_Column.Type = o_Catalog.Tables(Source_Table_Name).Columns(i).Type Value_Field Dest_Table_Name, o_Catalog.Tables(Source_Table_Name).Columns(i).Name, _ o_Catalog.Tables(Source_Table_Name).Columns(i).Properties("Default").Value Next i i_Columns = o_Catalog.Tables(Source_Table_Name).Indexes.Count - 1 For i = 0 To i_Columns Set obj_ADOX_Index = New ADOX.Index sIndex = o_Catalog.Tables(Source_Table_Name).Indexes.Item(i).Name obj_ADOX_Index.Name = sIndex obj_ADOX_Index.Unique = o_Catalog.Tables(Source_Table_Name).Indexes(i).Unique obj_ADOX_Index.Columns.Append sIndex o_Catalog.Tables(Dest_Table_Name).Indexes.Append obj_ADOX_Index Set obj_ADOX_Index = Nothing Next i If Not o_Catalog Is Nothing Then Set o_Catalog = Nothing End If If Not o_Column Is Nothing Then Set o_Column = Nothing End If Call Cerrar End Function Private Function ADOExecute(ByVal sql As String) As Boolean On Error Resume Next Dim ret As Boolean Dim Start As Long While cnn.State = 5 DoEvents obj_JetEngine.RefreshCache cnn Wend BoucleADOExecute: On Error GoTo ErrADOExecute Call cnn.Execute(sql, , adCmdText + adExecuteNoRecords + adAsyncExecute) Start = Timer Do DoEvents obj_JetEngine.RefreshCache cnn Loop Until cnn.State <> adStateExecuting Or Timer > Start ret = True QuitADOExecute: ADOExecute = ret Exit Function ErrADOExecute: If Err.Number = -2147467259 Then Resume BoucleADOExecute End If MsgBox Err.Description, , "ADOExecute" On Error Resume Next ret = False Resume QuitADOExecute End Function Private Sub Value_Field(ByVal Tabla As String, _ ByVal Campo As String, _ ByVal Valor As Variant) On Error Resume Next Dim o_Catalog As New ADOX.Catalog Dim Tipo As ADOX.DataTypeEnum While cnn.State = 5 DoEvents obj_JetEngine.RefreshCache cnn Wend Set o_Catalog.ActiveConnection = cnn Tipo = o_Catalog.Tables(Tabla).Columns(Campo).Type With o_Catalog.Tables(Tabla).Columns(Campo) If Tipo = adVarWChar Then .Properties("Default") = CStr(Valor) ElseIf Tipo = adCurrency Then .Properties("Default").Value = CCur(Valor) ElseIf Tipo = adBoolean Then ' .Properties("Default").Value = CBool(Valor) Else .Properties("Default").Value = Valor End If End With Set o_Catalog = Nothing End Sub ' Cierra la base de datos Private Sub Cerrar() If Not cnn Is Nothing Then If Not cnn.State = adStateOpen Then Do DoEvents Loop Until cnn.State = adStateClosed Set cnn = Nothing Set obj_JetEngine = Nothing End If End If End Sub ' Botón para clonar la tabla Private Sub Command1_Click() Call Clonar(cnn, Text2.Text, Text3.Text, Combo1.ListIndex) Command1.Enabled = False Command2.Enabled = True End Sub ' Botón para abrir la base de datos Private Sub Command2_Click() Call Abrir_Bd(Trim$(Text1.Text)) Command2.Enabled = False Command1.Enabled = True End Sub ' Abre la base de datos Private Function Abrir_Bd(Ruta_Bd As String, _ Optional Password As Variant = "") Dim ConnectionString As String ' Cadena de conexión y ruta de la base de datos Call Cerrar ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _ Ruta_Bd & ";Jet OLEDB:Database Password=" & Password Set cnn = New ADODB.Connection With cnn .CursorLocation = adUseClient .ConnectionString = ConnectionString .Open End With Set obj_JetEngine = New JRO.JetEngine While (cnn.State = adStateClosed) DoEvents Wend End Function Private Sub Form_Load() Command1.Caption = " Clonar tabla " Command1.Enabled = False Command2.Caption = " Abrir base de datos " Text1.Text = "C:\Archivos de programa\Microsoft Visual Studio\VB98\biblio.mdb" Text2.Text = "Authors" Text3.Text = "CopiaAuthors" Combo1.AddItem "Copiar estructura y datos " Combo1.AddItem "Copiar solo estructura" Combo1.ListIndex = 0 Me.Caption = " Clonar tabla " End Sub Private Sub Form_Unload(Cancel As Integer) Call Cerrar End Sub

Recursos visual basic 6.0 - enlacesrelacionados

Update de estructura de base de datos

Buscar en Recursos vb