Foros del web, para los que viven de bits

Private Sub Command1_Click()

Dim CVS As String
Dim XLS As String

With CommonDialog1
     'Para Abrir el CSV
     .Filter = "Archivo CSV|*.csv|Todos los archivos|*.*"
     .DialogTitle = " Seleccionar el archivo CSV"
     .ShowOpen
     CVS = .FileName
     'Para guardar el XLS
     .Filter = "Archivo Xls|*.xls"
     .FileName = ""
     .DialogTitle = " Escriba l nombre del archivo Xls "
     
     .ShowSave
     XLS = .FileName
End With

If CVS = "" Or XLS = "" Then
   Exit Sub
Else
   Call Exportar_CSV_XLS(CVS, XLS)
End If
End Sub

Private Sub Exportar_CSV_XLS(path_Cvs As String, path_Xls As String)

On Error GoTo ErrSub

Dim obj_Excel As Object
Dim Fila As Integer, Columna As Integer
Dim Contenido As String, Lineas As Variant
Dim datos As Variant, MC As Integer


    'Lee el contenido del CSV y lo almacena en la variable
    Open path_Cvs For Input As #1
    Contenido = Input$(LOF(1), #1)
    Close
    
    'Nuevo objeto Excel
    Set obj_Excel = CreateObject("Excel.Application")
    
    With obj_Excel
    'Agrega un libro
    .Workbooks.Add
    
    ' Obtiene el número de líneas del Csv con la función split
    Lineas = Split(Contenido, vbCrLf)
    
    For Fila = 0 To UBound(Lineas)
        
        'Separa los datos de la linea
        datos = Split(Lineas(Fila), ",")
        
        'Recorre los datos de esta fila que corresponden a cada campo
        For Columna = 0 To UBound(datos)
            ' Agrega el dato a la celda de la hoja activa
            .ActiveSheet.Cells(Fila + 1, Columna + 1) = datos(Columna)
        Next
        If MC < Columna Then
           MC = Columna
        End If
    Next
    
    'Selecciona toda la hoja
    .ActiveSheet.UsedRange.Select
    'Autoajusta las columnas
    .Selection.Columns.AutoFit
    
    
    'Selecciona el encabezado
    .ActiveSheet.Range(.ActiveSheet.Cells(1, 1), .ActiveSheet.Cells(1, MC)).Select
        
    End With
        
    ' Aplica atributos a la fuente a la selección anterior ( los encabezados )
    With obj_Excel.Selection.Font
        .Name = "Verdana"
        .FontStyle = "Bold"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Underline = xlUnderlineStyleNone
    End With

    ' Guarda el documento Xls
    obj_Excel.ActiveWorkbook.SaveAs _
        FileName:=path_Xls, _
        FileFormat:=xlNormal, _
        Password:="", _
        WriteResPassword:="", _
        ReadOnlyRecommended:=False, _
        CreateBackup:=False

    obj_Excel.ActiveWorkbook.Close False

    'Cierra el archivo y elimina la variable
    obj_Excel.Quit
    Set obj_Excel = Nothing
    
    'Fin
    MsgBox "Archivo Xls guardado ", vbInformation
    
    Exit Sub
    
'Error
ErrSub:
    MsgBox Err.Description
    On Error Resume Next
    If Not obj_Excel Is Nothing Then
       obj_Excel.Quit
      Set obj_Excel = Nothing
    End If
End Sub