Exportar a CSV
Visual Basic
Publicado el 16 de Octubre del 2005 por Christian Arenas Díaz
19.310 visualizaciones desde el 16 de Octubre del 2005
Código que permite exportar el contenido de un MSFlexGrid a un archivos *.CSV.
Iniciar sesiónCrear cuenta
Crear cuenta
Comentarios sobre la versión: Versión 1 (2)
Ademas, cagon, cuando quieras salvar un archivo por medio del CommonDialog utiliza .ShowSave no .ShowOpen hehehehe...
Saludos!
Rvdo. Astaroth®
Born in Golgotha DCLXVI
Private Sub Tbrmenu_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "Exportar"
pfbln_Exportar_Excel grdDatos, ComDialogExcel, True, True, , , "Exportar a Archivo", , ".xls", "Archivo de Excel (*.xls)|*.xls|CSV (Delimitado por comas) (*.csv)|*.csv", 1, True, ",", Chr(34), Chr(34)
Case "Salir"
Unload Me
End Select
End Sub
-- LLAMA A ESTA FUNCION
Function pfbln_Exportar_Excel(ByRef rgrdExp As TDBGrid, _
Optional ByRef rcdlExcel As CommonDialog, _
Optional ByVal vblnMostrarCommonDialog As Boolean = True, _
Optional ByVal vblnMostrarMensajeExito As Boolean = True, _
Optional ByVal vblnAppend As Boolean = False, _
Optional ByVal vintSelector As Integer = dbgAllRows, _
Optional ByVal vstrDialogTitle$ = "Exportar a Archivo", _
Optional ByVal vstrFileName$ = "*", _
Optional ByVal vstrDefaultExt$ = ".xls", _
Optional ByVal vstrFilter$ = "Archivo de Excel (*.xls)|*.xls|CSV (Delimitado por comas) (*.csv)|*.csv", _
Optional ByVal vintFilterIndex% = 1, _
Optional ByVal vblnExportToDelimitedFile As Boolean = True, _
Optional ByVal vstrDelim$ = ",", _
Optional ByVal vstrPrefix$ = """", _
Optional ByVal vstrSuffix$ = """", _
Optional ByVal vblnHeaders As Boolean = True) As Boolean
pfbln_Exportar_Excel = True
If rgrdExp.ApproxCount < 1 Then pfbln_Exportar_Excel = False: Exit Function
If vblnMostrarCommonDialog Then
rcdlExcel.DefaultExt = vstrDefaultExt
rcdlExcel.Filter = vstrFilter
rcdlExcel.FilterIndex = vintFilterIndex
rcdlExcel.DialogTitle = vstrDialogTitle
rcdlExcel.FileName = IIf(vstrFileName = "*", rcdlExcel.FileName, vstrFileName)
rcdlExcel.CancelError = True
On Error GoTo Cancel
rcdlExcel.ShowSave
GoTo OK
Cancel:
pfbln_Exportar_Excel = False
Exit Function
OK:
On Error GoTo 0
End If
If rcdlExcel.FileName = "" Then Exit Function
On Error GoTo Error
Screen.MousePointer = vbHourglass
If Not vblnExportToDelimitedFile Or UCase(Right(rcdlExcel.FileName, 3)) = UCase("xls") Then
rgrdExp.ExportToFile rcdlExcel.FileName, vblnAppend, vintSelector
Else
rgrdExp.ExportToDelimitedFile rcdlExcel.FileName, vintSelector, vstrDelim, vstrPrefix, vstrSuffix, vblnHeaders
End If
If vblnMostrarMensajeExito Then
If MsgBox("Exportación Satisfactoria en el Archivo: " & rcdlExcel.FileName & vbLf & "¿Desea abrirlo ahora?", vbQuestion + vbYesNo + vbDefaultButton2, "Exportación") = vbYes Then
ShellExecute 0, vbNullString, rcdlExcel.FileName, vbNullString, vbNullString, vbNormalFocus
End If
End If
GoTo Salida
Error:
MsgBox "Error : " & Err.Number & Chr(13) & Err.Description
pfbln_Exportar_Excel = False
Salida:
On Error GoTo 0
Screen.MousePointer = vbDefault
End Function
espero poder contar con tu apoyo
saludos