Exportar datagrid a excel

[t0n1]

Hola, que tal.

Estoy utilizando este codigo para exportar los resultados de un datagrid y los muestre en una hoja de Excel y me arroja este error:

"No se encontró "". Compruebe la ortografía del nombre del archivo y si ubicación es correcta.

Este es el código:

Código:

Dim cnn         As Connection  
Dim rs          As Recordset  
' -- Variables para Excel  
Dim Obj_Excel   As Object  
Dim Obj_Libro   As Object  
Dim Obj_Hoja    As Object  
  

Private Sub exportar_Datagrid(Datagrid As Datagrid, n_Filas As Long)  
  
    On Error GoTo Error_Handler  
      
    Dim i   As Integer  
    Dim j   As Integer  
      

    Me.MousePointer = vbHourglass  
      
    If n_Filas = 0 Then  
        MsgBox "No hay datos para exportar a excel. Se ha indicado 0 en el parámetro Filas ": Exit Sub  
    Else  
          
  
        Set Obj_Excel = CreateObject("Excel.Application")  
 
        Set Obj_Libro = Obj_Excel.Workbooks.Open(Path)  
      

        Set Obj_Hoja = Obj_Excel.ActiveSheet  
     
        iCol = 0  
       
        For i = 0 To Datagrid.Columns.Count - 1  
            If Datagrid.Columns(i).Visible Then  
             
                iCol = iCol + 1  
               
                Obj_Hoja.Cells(1, iCol) = Datagrid.Columns(i).Caption  
                
                For j = 0 To n_Filas - 1  
                  
                    Obj_Hoja.Cells(j + 2, iCol) = _  
                    Datagrid.Columns(i).CellValue(Datagrid.GetBookmark(j))  
                Next  
            End If  
        Next  
          
      
        Obj_Excel.Visible = True  
          
       
        With Obj_Hoja  
            .Rows(1).Font.Bold = True  
            .Rows(1).Font.Color = vbRed  
           
            .Columns("A:Z").AutoFit  
        End With  
    End If  
  

    Set Obj_Hoja = Nothing  
    Set Obj_Libro = Nothing  
    Set Obj_Excel = Nothing  
      
    Me.MousePointer = vbDefault  
      
Exit Sub  
  

Error_Handler:  
  
    MsgBox Err.Description, vbCritical  
    On Error Resume Next  
  
    Set Obj_Hoja = Nothing  
    Set Obj_Libro = Nothing  
    Set Obj_Excel = Nothing  
    Me.MousePointer = vbDefault  
  
End Sub  

Private Sub Command1_Click()  
    Call exportar_Datagrid(DataGrid1, DataGrid1.ApproxCount)  
End Sub

[t0n1]

Corregí el código y pude solucionar el problema. Lo que ocurre ahora es que se genera el excel pero sólo muestra los encabezados de las columnas sin ningún registro.

Acá está el código nuevo:

Código:

Public Function Exportar_Excel(sOutputPath As String, DataGrid As Object) As Boolean
  
    On Error GoTo Error_Handler
      
    
  
   
    Dim Fila        As Long
    Dim Columna     As Long
      
    ' -- Crea el objeto Excel, el objeto workBook y el objeto sheet
    Set o_Excel = CreateObject("Excel.Application")
    Set o_Libro = o_Excel.Workbooks.Add
    Set o_Hoja = o_Libro.Worksheets.Add
     
     iCol = 0
        ' --  Recorrer el Datagrid ( Las columnas )
        For i = 0 To DataGrid.Columns.Count - 1
            If DataGrid.Columns(i).Visible Then
                ' -- Incrementar índice de columna
                iCol = iCol + 1
                ' -- Obtener el caption de la columna
                o_Hoja.Cells(1, iCol) = DataGrid.Columns(i).Caption
                ' -- Recorrer las filas
                For j = 0 To n_Filas - 1
                    ' -- Asignar el valor a la celda del Excel
                    o_Hoja.Cells(j + 2, iCol) = _
                    DataGrid.Columns(i).CellValue(DataGrid.GetBookmark(j))
                Next
            End If
        Next
       o_Libro.Close True, sOutputPath
    ' -- Cerrar Excel
    o_Excel.Quit
    ' -- Terminar instancias
    Call ReleaseObjects(o_Excel, o_Libro, o_Hoja)
    Exportar_Excel = True
Exit Function
  
' -- Controlador de Errores
Error_Handler:
    ' -- Cierra la hoja y el la aplicación Excel
    If Not o_Libro Is Nothing Then: o_Libro.Close False
    If Not o_Excel Is Nothing Then: o_Excel.Quit
    Call ReleaseObjects(o_Excel, o_Libro, o_Hoja)
    If Err.Number <> 1004 Then MsgBox Err.Description, vbCritical
End Function
' -------------------------------------------------------------------
' \\ -- Eliminar objetos para liberar recursos
' -------------------------------------------------------------------
Private Sub ReleaseObjects(o_Excel As Object, o_Libro As Object, o_Hoja As Object)
    If Not o_Excel Is Nothing Then Set o_Excel = Nothing
    If Not o_Libro Is Nothing Then Set o_Libro = Nothing
    If Not o_Hoja Is Nothing Then Set o_Hoja = Nothing
End Sub

[t0n1]

Listo, lo solucioné,

reemplacé For j = 0 To n_Filas - 1 por For j = 0 To Form1.Datagrid1.ApproxCount - 1


Slds