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

299 - Importar archivo de texto a Excel en vba usando Ado

Ejemplo en vba para Excel , de como conectarse mediante Ado a un archivo de texto, y copiar los datos del recordset a un rango de la hoja

En el código hay una función llamada Importar_txt que tiene tres parámetros.

1 - El primer parámetro es el path de la carpeta donde está el archivo de texto, csv etc. ( La ruta de la carpeta, NO del archivo )
2 - El segundo es la consulta SQL. En la consulta se debe indicar el nombre del archivo, por ejemplo : SELECT * FROM UnArchivo.csv ORDER BY asc
3 - El tercero es el rango, que es una variable de tipo Range, por ejemplo Range("A1")

importante: este ejemplo solo funciona para versiones de Excel superiores a la 97, ya que al copiar el recordset con CopyFromrecordset, en dichas versiones dará error en esa línea. En ese caso, en el siguiente enlace hay un ejemplo que se puede adaptar para pasar un recordset ADO a una hoja de excel: Exportar un Recordset ADO a una hoja de Excel

Controles y referencias

1 - En la planilla de cálculo, un BommandButton que ejecuta la función para importar, es decir el código está en el evento Clic del mismo
2 - Añadir la referencia a ADO
3 - Un módulo para la función

Código fuente en el Módulo

' Agregar la referencia para ADO '****************************************************** Function Importar_Txt( _ SQL As String, _ Path_Carpeta_Txt As String, _ Optional Rango As Range) As Boolean On Error GoTo Err_Importar 'Variables para la conexión, el recordset y para recorrer los Fields Dim cnn As ADODB.Connection Dim rst As ADODB.Recordset Dim Columna As Integer If Rango Is Nothing Then Set Rango = Range("A1") End If 'Nueva conexión ADO Set cnn = New ADODB.Connection On Error Resume Next ' Usa la cadena de conexión para archivos de texto cnn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _ "Dbq=" & Path_Carpeta_Txt & ";" & _ "Extensions=asc,csv,tab,txt;" ' Limpia el error On Error GoTo 0 If cnn.State <> adStateOpen Then Set cnn = Nothing Exit Function End If ' Nuevo recordset Ado Set rst = New ADODB.Recordset On Error Resume Next ' Trae los datos al recordset rst.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText On Error GoTo 0 'Si el recordset no está abiero ... sale If rst.State <> adStateOpen Then cnn.Close 'Cierra la conexión Set cnn = Nothing Exit Function End If '*********************************************************** 'Importa los datos del Txt '*********************************************************** ' Recorre el caption de las cabeceras For Columna = 0 To rst.Fields.Count - 1 Rango.Offset(0, Columna).Formula = rst.Fields(Columna).Name Next 'Verifica la versión de Excel ( debe ser mayor a la versión 97 ) If Excel.Application.Version >= 8 Then MsgBox "Este ejemplo es para versiones de Excel mayores a 97 ", vbCritical Else Rango.Offset(1, 0).CopyFromRecordset rst Importar_Txt = True End If 'Cierra el recordset y la conexión rst.Close Set rst = Nothing cnn.Close Set cnn = Nothing Exit Function ' Error Err_Importar: MsgBox Err.Description, vbCritical End Function

Código en el CommandButton

Private Sub CommandButton1_Click() Dim ret As Boolean 'Le envía la consulta Sql, el path donde está el txt, csv etc.., y el rango ret = Importar_Txt("Select * From Archivo.txt", "c:\carpeta") If ret Then MsgBox " Datos importados ", vbInformation ' OK End If End Sub

Recursos vb 6.0 - Enlaces relacionados

Buscar en Recursos vb