Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1479

[VB] Parsing Excel tabbed data to the object (and vice versa)

$
0
0
Parsing the data that was copied from Excel.
Data with header is represented as the Collections in the Dictionary.
Data without header is represented as the Collections in the Collection.

Do not forget to add Microsoft Scripting Runtime to the references.

VB Code:
  1. Public Function FromTable(s As String, Optional WithHeader As Boolean = True, _
  2.   Optional Delimiter As String = vbTab) As Object
  3.   Dim TC As Collection, TD As Dictionary, Columns() As Collection
  4.   Dim Rows() As String, Row() As String, Header() As String
  5.   Dim iRow As Long, nRows As Long, iColumn As Long, nColumns As Long, nCurColumns As Long
  6.   If Len(Delimiter) <> 0 Then
  7.     If WithHeader = True Then
  8.       Set TD = New Dictionary
  9.       Rows = Split(s, vbCrLf)
  10.       nRows = UBound(Rows)
  11.       If nRows <> -1 Then
  12.         Header = Split(Rows(0), Delimiter)
  13.         nColumns = UBound(Header)
  14.         ReDim Preserve Columns(nColumns)
  15.         For iColumn = 0 To nColumns
  16.           Set Columns(iColumn) = New Collection
  17.           TD.Add Header(iColumn), Columns(iColumn)
  18.         Next iColumn
  19.         For iRow = 1 To nRows
  20.           Row = Split(Rows(iRow), Delimiter)
  21.           nCurColumns = UBound(Row)
  22.           If nCurColumns > nColumns Then
  23.             nCurColumns = nColumns
  24.           End If
  25.           For iColumn = 0 To nCurColumns
  26.             Columns(iColumn).Add Row(iColumn)
  27.           Next iColumn
  28.           For iColumn = nColumns + 1 To nColumns
  29.             Columns(iColumn).Add vbNullString
  30.           Next iColumn
  31.         Next iRow
  32.         Set FromTable = TD
  33.       End If
  34.     Else
  35.       Set TC = New Collection
  36.       Rows = Split(s, vbCrLf)
  37.       nRows = UBound(Rows)
  38.       If nRows <> -1 Then
  39.         Row = Split(Rows(0), Delimiter)
  40.         nColumns = UBound(Row)
  41.         ReDim Preserve Columns(nColumns)
  42.         For iColumn = 0 To nColumns
  43.           Set Columns(iColumn) = New Collection
  44.           TC.Add Columns(iColumn)
  45.           Columns(iColumn).Add Row(iColumn)
  46.         Next iColumn
  47.         For iRow = 1 To nRows
  48.           Row = Split(Rows(iRow), Delimiter)
  49.           nCurColumns = UBound(Row)
  50.           If nCurColumns > nColumns Then
  51.             nCurColumns = nColumns
  52.           End If
  53.           For iColumn = 0 To nCurColumns
  54.             Columns(iColumn).Add Row(iColumn)
  55.           Next iColumn
  56.           For iColumn = nColumns + 1 To nColumns
  57.             Columns(iColumn).Add vbNullString
  58.           Next iColumn
  59.         Next iRow
  60.         Set FromTable = TC
  61.       End If
  62.     End If
  63.   End If
  64. End Function
  65.  
  66. Public Function IsCollection(a) As Boolean
  67.   If IsObject(a) Then
  68.     If ObjPtr(a) <> 0 Then
  69.       If TypeOf a Is Collection Then
  70.         IsCollection = True
  71.       End If
  72.     End If
  73.   End If
  74. End Function
  75. Public Function ToTable(obj As Object, Optional Delimiter As String = vbTab) As String
  76.   Dim iColumn As Long, nColumns As Long
  77.   Dim iRow As Long, nRows As Long, Items(), Columns() As Collection
  78.   If (Len(Delimiter) <> 0) And IsObject(obj) Then
  79.     If ObjPtr(obj) <> 0 Then
  80.       If TypeOf obj Is Dictionary Then
  81.         nColumns = obj.Count - 1
  82.         If nColumns >= 0 Then
  83.           Items = obj.Items
  84.           ReDim Preserve Columns(nColumns)
  85.           For iColumn = 0 To nColumns
  86.             If IsCollection(Items(iColumn)) = True Then
  87.               Set Columns(iColumn) = Items(iColumn)
  88.             Else
  89.               Exit Function
  90.             End If
  91.           Next iColumn
  92.         End If
  93.       ElseIf TypeOf obj Is Collection Then
  94.         nColumns = obj.Count - 1
  95.         If nColumns >= 0 Then
  96.           ReDim Preserve Columns(nColumns)
  97.           For iColumn = 0 To nColumns
  98.             If IsCollection(obj(iColumn + 1)) Then
  99.               Set Columns(iColumn) = obj(iColumn + 1)
  100.             Else
  101.               Exit Function
  102.             End If
  103.           Next iColumn
  104.         End If
  105.       Else
  106.         Exit Function
  107.       End If
  108.       For iRow = 1 To Columns(0).Count
  109.         For iColumn = 0 To nColumns
  110.           ToTable = ToTable & Columns(iColumn)(iRow)
  111.           If iColumn <> nColumns Then
  112.              ToTable = ToTable & Delimiter
  113.           Else
  114.             ToTable = ToTable & vbCrLf
  115.           End If
  116.         Next iColumn
  117.       Next iRow
  118.     End If
  119.   End If
  120. End Function

Viewing all articles
Browse latest Browse all 1479

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>