Código de Visual Basic - Exportar a CSV

Exportar a CSV

Visual Basic

(2)

Publicado el 16 de Octubre del 2005 por Christian Arenas Díaz

19.631 visualizaciones desde el 16 de Octubre del 2005

Código que permite exportar el contenido de un MSFlexGrid a un archivos *.CSV.

Versión 1
(2)

Publicado el 16 de Octubre del 2005

gráfica de visualizaciones de la versión: Versión 1

19.632 visualizaciones desde el 16 de Octubre del 2005

Si alguno de los archivos de descarga no funciona, comentanos aquí el error.

Comentarios sobre la versión: Versión 1 (2)

Rvdo. Astaroth®

15 de Marzo del 2006

Pues una simple creacion de un archivo de texto plano... mmmm...

Ademas, cagon, cuando quieras salvar un archivo por medio del CommonDialog utiliza .ShowSave no .ShowOpen hehehehe...

Saludos!
Rvdo. Astaroth®
Born in Golgotha DCLXVI

Responder

miguel

8 de Marzo del 2011

en mi caso al momento de la exportación en csv me indica el sgte emsje Error : 6277 Output file access error. Lo tengo trabajado de esta forma
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

Responder