Importar Datos desde CSV a Excel en VBA

[alexortiz]

Buenas a todos!

Soy nuevo por estos lugares y ando con un proyecto que paso a redactar.

Estoy creando un analizador de datos los cuales los tengo en archivos CSV. Para ello, necesito importar los datos desde archivos CSV a una de las hojas de Excel. Buscando por internet, he encontrado un tutorial que realiza la importacion de datos desde Access a Excel de la forma que necesito pero no se cuales son las modificaciones que necesito hacerle al codigo para que me importe los CSV. Aqui muestro el codigo:

Sub ImportarDatosProduccionAccess()

Dim DatosProduccion As New ADODB.Recordset

Dim Conexion As New ADODB.Connection

Dim CaracteristicasConexion As String

Dim InstruccionSql As String



On Error GoTo ControlErrores



    Application.ScreenUpdating = False

    HojaDatos.Visible = xlSheetVisible

    HojaDatos.Select


    InstruccionSql = "SELECT FechaProduccion, PlantaProduccion, PaisProduccion, UnidadesProduccion FROM tblProduccion ORDER BY FechaProduccion, PaisProduccion"

    CaracteristicasConexion = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & HojaOpciones.Range("B1")


    Conexion.Open ConnectionString:=CaracteristicasConexion

    DatosProduccion.Open Source:=InstruccionSql, ActiveConnection:=Conexion


    If DatosProduccion.EOF = True Then

        MsgBox "No se han encontrado datos de producción en la base de datos.", vbInformation

    Else

        Range("A2").CopyFromRecordset Data:=DatosProduccion

        cargarPaises

        frmEstadisticas.Show


    End If


    Conexion.Close

    Set Conexion = Nothing

    Set DatosProduccion = Nothing


    HojaDatos.Visible = xlSheetVeryHidden


    Exit Sub


ControlErrores:

    ' esta es otra opcion MsgBox Err.Number & vbNewLine & Err.Description

    If Err.Number = -2147467259 Then

    MsgBox "No se ha encontrado la base de datos. Accede a las opciones para indicar una nueva ubicación para la base de datos.", vbCritical

    Else

        MsgBox "Se ha producido un error!!! " & vbNewLine & "Código: " & Err.Number & vbNewLine & "Descripcion: " & Err.Description, vbInformation

        MsgBox "El error se encuentra en: " & Err.Source

    End If


    Set Conexion = Nothing

    Set DatosProduccion = Nothing


    HojaDatos.Visible = xlSheetVeryHidden


End Sub

[/CODE]

Gracias por la ayuda.

[Potter08]

Hola, revisa el siguiente enlace de la web hay un ejemplo que te puede servir.

https://www.ayudaexcel.com/2011/02/04/importar-archivos-csv/

Salu2.xlsx

[alexortiz]

Pero ese codigo tiene el problema que le tienes que dar la ruta en codigo para abrir el archivo y busco que lo pueda hacer desde un buscador. Tengo realizado un buscador para darle la ruta:

Private Sub cmdAceptar_Click()

    HojaOpciones.Range("B1") = lblBaseDeDatos.Caption

    Unload Me


End Sub



Private Sub cmdCancerlar_Click()

    Unload Me


End Sub



Private Sub cmdPredeterminada_Click()

    lblBaseDeDatos.Caption = ThisWorkbook.Path & "\Produccion.accdb"


End Sub



Private Sub cmdSeleccionarBase_Click()

Dim BaseDeDatos As String



    BaseDeDatos = Application.GetOpenFilename("Bases de datos Access (*.accdb),*.accdb")


    If BaseDeDatos <> "Falso" Then

        lblBaseDeDatos.Caption = BaseDeDatos

    End If




End Sub



Private Sub UserForm_Initialize()

    lblBaseDeDatos.Caption = HojaOpciones.Range("B1")


End Sub



[/CODE]

Aparte tampoco quiero que me borrer el archivo CSV despues de leerlo.

Gracias de nuevo.

[Potter08]

Prueba con este codigo:

Sub LargeFileImport()

      'Dimension Variables
      Dim ResultStr As String
      Dim FileName As String
      Dim FileNum As Integer
      Dim Counter As Double
      'Ask User for File's Name
      FileName = InputBox("Please enter the Text File's name, e.g. test.txt")
      'Check for no entry
      If FileName = "" Then End
      'Get Next Available File Handle Number
      FileNum = FreeFile()
      'Open Text File For Input
      Open FileName For Input As #FileNum
      'Turn Screen Updating Off
      Application.ScreenUpdating = False
      'Create A New WorkBook With One Worksheet In It
      Workbooks.Add template:=xlWorksheet
      'Set The Counter to 1
      Counter = 1
      'Loop Until the End Of File Is Reached
      Do While Seek(FileNum) <= LOF(FileNum)
         'Display Importing Row Number On Status Bar
          Application.StatusBar = "Importing Row " & _
             Counter & " of text file " & FileName
          'Store One Line Of Text From File To Variable
          Line Input #FileNum, ResultStr
          'Store Variable Data Into Active Cell
          If Left(ResultStr, 1) = "=" Then
             ActiveCell.Value = "'" & ResultStr
          Else
             ActiveCell.Value = ResultStr
          End If

          'For Excel versions before Excel 97, change 65536 to 16384
          If ActiveCell.Row = 65536 Then
             'If On The Last Row Then Add A New Sheet
             ActiveWorkbook.Sheets.Add
          Else
             'If Not The Last Row Then Go One Cell Down
             ActiveCell.Offset(1, 0).Select
          End If
          'Increment the Counter By 1
          Counter = Counter + 1
      'Start Again At Top Of 'Do While' Statement
      Loop
      'Close The Open Text File
      Close
      'Remove Message From Status Bar
      Application.StatusBar = False

   End Sub[/PHP]

Fuente:

Text files that are larger than 65,536 rows cannot be imported to Excel 97, Excel 2000, Excel 2002 and Excel 2003

Salu2.xlsx

[color=blue]- - - - - Mensaje combinado - - - - -[/color]

otro ejemplo mas.

[PHP]Sub Import_Large_Textfiles_DAO()
'Note: A reference must be set to Microsoft DAO 3.5 or 3.51
'Note: A reference must be set to Microsoft Scripting Runtime
Dim stPath As String, stFilename As String, stGetFile As String
Dim Db As DAO.Database
Dim Rst As DAO.Recordset
Dim fsoObj As FileSystemObject

stGetFile = Application.GetOpenFilename("CSVfiles (*.csv),*.CSV", , "Please select a CSVfile...")


Application.ScreenUpdating = False
Set fsoObj = CreateObject("Scripting.FileSystemObject")
stPath = fsoObj.GetFile(stGetFile).ParentFolder.Path
stFilename = fsoObj.GetFile(stGetFile).Name
Set Db = OpenDatabase(stPath, False, True, "TEXT;")
Set Rst = Db.OpenRecordset("SELECT * FROM " & stFilename)
While Not Rst.EOF
Worksheets.Add
ActiveSheet.Range("A1").CopyFromRecordset Rst, 10
Wend
Rst.Close
Db.Close
Application.ScreenUpdating = True
End Sub[/PHP]

Salu2.xlsx

[alexortiz]

Muchas Gracias por todo!

Ya consegui hacerlo funcionar bastante bien. Para ser un novato, la verdad es que me funciona todo bastante correcto. Ahora solo tengo un fallo.

Cuando importo los datos del CSV y los transformo a columnas separadas, cuando borro esos datos y vuelvo a importar otros, ya me salen en columnas separas. Como se borra ese formato para que cuando me lo importe vuelva a estar solo en una columna?¿

Yo estoy usando la funcion ClearFormats pero no me funciona.

Un saludo y gracias por la ayuda.