Export ReportControl data as CSV file

Hi,

 

I have copied 2 functions below that will export the contents of the report control into a file. The functions create a TAB delimited file If you want a CSV file, simply change the TAB delimiter to a comma and the filename extension to csv instead of txt.

 

To use the function, simply execute the line below

   Call ExportRecords(ReportControl, False)

 

The second parameter is for exporting selecting rows or all rows.

You will also need a reference to the Microsoft Scripting Runtime library to create the file. You can change this to use VB intrinsic file functions of course.

 

 

 

 

 

Public Function ExportRecords(ByRef rptControl As XtremeReportControl.ReportControl, Optional ByVal bolUseSelectedRows As Boolean = False) As Boolean
   Dim Row As ReportRow
   Dim Col As ReportColumn
   Dim Columns As ReportColumns
   Dim Rows As ReportRows
  
   Dim lngCols As Long
   Dim Cols() As Long
  
   Dim strItemLine As String
   Dim strColumnHeaders As String
   Dim strBuffer As String
   Dim strFileName As String
  
   Dim objStream As TextStream
   Dim objFS As FileSystemObject
   
   
   On Error GoTo ErrHandler
   
   'A reference to a Common Dialog control on your Form      

   'Get the file to export to from user
   With dlgCommonDialog
     
      .CancelError = False
      .DialogTitle = "Save as..."
      .FileName = "Exported data.txt"
      .Filter = "Exported data|*.txt"
      .FilterIndex = 1
      .flags = cdlOFNNoReadOnlyReturn Or cdlOFNHideReadOnly
      .InitDir = App.Path
      .ShowSave
      strFileName = .FileName
  
   End With
           
   If LenB(strFileName) > 0 Then
      Set objFS = New FileSystemObject
      Set objStream = objFS.OpenTextFile(strFileName, ForWriting, True)
               
      strColumnHeaders = ""
      Set Columns = rptControl.Columns
      lngCols = 0
     
      'Create an array of the column order indexes as they may have changed by user
      For Each Col In Columns
         If Col.Visible Then  'I am interested in visible columns only
            If lngCols > 0 Then strColumnHeaders = strColumnHeaders & vbTab
            strColumnHeaders = strColumnHeaders & Col.Caption
            ReDim Preserve Cols(lngCols)
            Cols(lngCols) = Col.ItemIndex 'Get the order of the column indexes
            lngCols = lngCols + 1
         End If
      Next Col
        
      objStream.WriteLine strColumnHeaders
     
      If bolUseSelectedRows Then
  
         For Each Row In rptControl.SelectedRows
            strItemLine = GetExportRecord(Columns, Row, Cols, True, False)
            If LenB(strItemLine) > 0 Then
               objStream.WriteLine strItemLine
            End If
           
         Next Row
     
      Else
  
         For Each Row In rptControl.Rows
            strItemLine = GetExportRecord(Columns, Row, Cols, True, False)
            If LenB(strItemLine) > 0 Then
               objStream.WriteLine strItemLine
            End If
           
         Next Row
        
      End If
        
      objStream.Close
      ExportRecords = True
  
   End If 'LenB(strFileName)

Exit_Proc:
  
   Set objStream = Nothing
   Set objFS = Nothing
   Set Row = Nothing
   Set Col = Nothing
   Set Columns = Nothing
   Set Rows = Nothing
   
   Exit Function
  
ErrHandler:
   'Error handling here
   Resume Exit_Proc:

End Function

 

'GetExportRecord
Private Function GetExportRecord(ByRef Columns As ReportColumns, ByRef Row As ReportRow, ByRef Cols() As Long, Optional ByVal bolOnlyVisibleRecords = True, Optional ByVal bolUseDoubleQuoteData As Boolean = False) As String
   Dim Col As ReportColumn
   Dim Item As ReportRecordItem
   Dim i As Long, j As Long, k As Long
   Dim lngCols As Long
   Dim strItem As String
   Dim bolContinue As Boolean
  
  
   'Test the Col array to ensure you have columns to traverse
   On Error Resume Next
  
   lngCols = UBound(Cols)
     
   If Err.Number = 0 Then
     
      On Error GoTo ErrHandler
     
      GetExportRecord = ""
  
      If Not Row.GroupRow Then
        
         If bolOnlyVisibleRecords Then
            bolContinue = Row.Record.Visible
         Else
            bolContinue = True
         End If
        
         If bolContinue Then
            For i = 0 To lngCols
              
               strItem = ""
               Set Col = Columns.Find(Cols(i))
                              
               If Col.Visible Then

 

                  Set Item = Row.Record.Item(Cols(i))
                  If Item.HasCheckbox Then
                     strItem = IIf(Item.Checked, "TRUE", "FALSE")
                  Else
                     If Col.EditOptions.ConstraintEdit Then
                        k = Col.EditOptions.Constraints.Count - 1
                        For j = 0 To k
                           If Col.EditOptions.Constraints(j).Data = Item.value Then
                              strItem = Col.EditOptions.Constraints(j).Caption
                              Exit For
                           End If
                        Next j
                     Else
                        strItem = Item.value
                     End If 'ConstraintEdit
                  End If 'HasCheckbox
                 
                  If LenB(GetExportRecord) > 0 Then GetExportRecord = GetExportRecord & vbTab
                  If bolUseDoubleQuoteData Then strItem = """" & strItem & """"
                 
                  'Replace carriage return line feed characters with a space
                  GetExportRecord = GetExportRecord & Replace(strItem, vbCrLf, " ")
                 
               End If 'Col.Visible
           
            Next i
                                   
         End If 'Row.Record.Visible
      End If 'Not Row.GroupRow
  
   End If

   Exit Function
  
ErrHandler:
  
   Debug.Print "GetExportRecord", Err.Number, Err.Description
  
End Function