Linq anonymous type to datatable

' This code has been provided by Andrew Conrad from Microsoft
' See http://blogs.msdn.com/aconrad/archive/2007/09/07/science-project.aspx
 
 
Public Class LINQtoDataTable(Of T)
    Private fiLINQResult As System.Reflection.FieldInfo()
    Private piLINQResult As System.Reflection.PropertyInfo()
    Private dicOrdinalMap As System.Collections.Generic.Dictionary(Of String, Integer)
    Private typLINQResult As Type
    Private msource As System.Collections.Generic.IEnumerable(Of T)
 
    Public Sub New()
        typLINQResult = GetType(T)
        fiLINQResult = typLINQResult.GetFields()
        piLINQResult = typLINQResult.GetProperties()
        dicOrdinalMap = New System.Collections.Generic.Dictionary(Of String, Integer)()
    End Sub
 
	Public Function ToCciDataTable(ByVal source As System.Collections.Generic.IEnumerable(Of T), ByVal dtbTable As DataTable, _
 ByVal options As Data.LoadOption?) As DataTable
		Dim dtbBlankTable As DataTable = dtbTable.Clone
		msource = source
 
		If GetType(T) Is GetType(DataRow) Then '"System.Data.DataRow" Then
			If source.Count = 0 Then Return dtbBlankTable
 
			If source.GetType Is GetType(DataRow()) Then ' "System.Data.DataRow[]" Then
				Dim dtbReturn As DataRow() = CType(source, System.Data.DataRow())
				Return dtbReturn.CopyToDataTable
			Else
				Dim dtbReturn As Data.EnumerableRowCollection(Of Data.DataRow) = CType(source, System.Data.EnumerableRowCollection(Of Data.DataRow))
				Return dtbReturn.CopyToDataTable()
			End If
 
		Else
			Return Shred(source, dtbBlankTable, options)
 
		End If
	End Function
 
	Public Function Shred(ByVal source As System.Collections.Generic.IEnumerable(Of T), ByVal dtbTable As DataTable, _
	 ByVal options As Data.LoadOption?) As DataTable
 
		'it Linq result only has one column selected
		If IsPrimitiveOrCommom(GetType(T)) OrElse (fiLINQResult.Length = 0 AndAlso piLINQResult.Length = 0 AndAlso dicOrdinalMap.Count = 0) Then
			Return ShredPrimitive(source, dtbTable, options)
		End If
 
		If dtbTable Is Nothing Then
			dtbTable = New DataTable(GetType(T).Name)
 
		End If
 
		' now see if need to extend DataTable base on the type T + build ordinal map
		dtbTable = ExtendTable(dtbTable, GetType(T))
 
		dtbTable.BeginLoadData()
		Using e As System.Collections.Generic.IEnumerator(Of T) = source.GetEnumerator()
			While e.MoveNext()
				If options IsNot Nothing Then
					dtbTable.LoadDataRow(ShredObject(dtbTable, e.Current), options.Value)
				Else
					dtbTable.LoadDataRow(ShredObject(dtbTable, e.Current), True)
				End If
			End While
		End Using
		dtbTable.EndLoadData()
 
		Dim int As Int32 = 0
 
		For Each column As DataColumn In dtbTable.Columns
			If column.DataType Is GetType(DataRow) Then
				int += 1
			End If
		Next
 
		If dtbTable.Columns.Count = int Then
			Return MergeRowsWithTable(dtbTable)
		End If
 
		Return dtbTable
	End Function
 
	Public Function ShredPrimitive(ByVal source As System.Collections.Generic.IEnumerable(Of T), _
			ByVal dtbTable As DataTable, ByVal options As Data.LoadOption?) As DataTable
		If dtbTable Is Nothing Then
			dtbTable = New DataTable(GetType(T).Name)
		End If
 
		If Not dtbTable.Columns.Contains("Value") Then
			dtbTable.Columns.Add("Value", GetType(T))
		End If
 
		dtbTable.BeginLoadData()
		Using e As System.Collections.Generic.IEnumerator(Of T) = source.GetEnumerator()
			'This is commented so that Option infer does not need to be turned on
			'Dim values = New Object(table.Columns.Count - 1) {}
			Dim values As Object()
			values = New Object(dtbTable.Columns.Count - 1) {}
			While e.MoveNext()
				values(dtbTable.Columns("Value").Ordinal) = e.Current
				If Not options Is Nothing Then
					dtbTable.LoadDataRow(values, options.Value)
				Else
					dtbTable.LoadDataRow(values, True)
				End If
			End While
		End Using
		dtbTable.EndLoadData()
		Return dtbTable
	End Function
 
	Public Function ExtendTable(ByVal dtbTable As DataTable, ByVal type As Type) As DataTable
		' value is type derived from T, may need to extend table.
		'If type Is GetType(Data.DataRow) Then
		'    For Each col As DataColumn In dtbTable.Columns
		'        dicOrdinalMap.Add(col.ColumnName, col.Ordinal)
		'    Next
		'    Return dtbTable
		'End If
		For Each f As System.Reflection.FieldInfo In type.GetFields()
			If Not dicOrdinalMap.ContainsKey(f.Name) Then
				Dim dc As Data.DataColumn = If(dtbTable.Columns.Contains(f.Name), dtbTable.Columns(f.Name), dtbTable.Columns.Add(f.Name, f.FieldType))
				dicOrdinalMap.Add(f.Name, dc.Ordinal)
			End If
		Next
		For Each p As System.Reflection.PropertyInfo In type.GetProperties()
			If Not dicOrdinalMap.ContainsKey(p.Name) Then
				Dim colType As Type = p.PropertyType
				'If LINQ field is nullable this is how it gets the datatype of that field
				If (colType.IsGenericType) AndAlso (colType.GetGenericTypeDefinition() Is GetType(Nullable(Of ))) Then
					colType = colType.GetGenericArguments()(0)
				End If
 
				Dim dc As Data.DataColumn = If(dtbTable.Columns.Contains(p.Name), dtbTable.Columns(p.Name), dtbTable.Columns.Add(p.Name, colType))
				dicOrdinalMap.Add(p.Name, dc.Ordinal)
			End If
		Next
		Return dtbTable
	End Function
 
	Public Function ShredObject(ByVal table As DataTable, ByVal instance As T) As Object()
		Dim fi As System.Reflection.FieldInfo() = fiLINQResult
		Dim pi As System.Reflection.PropertyInfo() = piLINQResult
 
		If instance.GetType() IsNot GetType(T) Then
			ExtendTable(table, instance.GetType())
			fi = instance.GetType().GetFields()
			pi = instance.GetType().GetProperties()
		End If
 
		Dim values As Object() = New Object(table.Columns.Count - 1) {}
		For Each f As System.Reflection.FieldInfo In fi
			values(dicOrdinalMap(f.Name)) = f.GetValue(instance)
		Next
 
		For Each p As System.Reflection.PropertyInfo In pi
			'If table.Columns.Contains(p.Name) Then
			values(dicOrdinalMap(p.Name)) = p.GetValue(instance, Nothing)
			'End If
		Next
 
		Return values
	End Function
 
	Private Function IsPrimitiveOrCommom(ByVal type As System.Type) As Boolean
		If type.IsPrimitive Then Return True
		If type Is GetType(Decimal) Then Return True
		If type Is GetType(String) Then Return True
		Return False
	End Function
 
	Private Function MergeRowsWithTable(ByVal dtbTable As DataTable) As DataTable
		Dim dtbMergedTable As New DataTable
		Dim dicTables As New Dictionary(Of String, DataRow)
 
		For Each item As DataColumn In dtbTable.Rows(0).Table.Columns
			dicTables.Add(item.ColumnName, CType(dtbTable(0)(item.ColumnName), DataRow))
		Next
 
		dtbMergedTable = MergeDataRowsStruture(dtbMergedTable, CreateColumnList(dicTables))
 
		For Each row As DataRow In dtbTable.Rows
			CopyDataToMergeTable(row, dtbMergedTable)
		Next
 
		Return dtbMergedTable
	End Function
 
	Private Function CreateColumnList(ByVal rows As Dictionary(Of String, DataRow)) As Collections.Generic.Dictionary(Of String(), DataColumn)
		Dim dicColumns As New Collections.Generic.Dictionary(Of String(), DataColumn)
		For Each key As String In rows.Keys
			For Each column As DataColumn In rows(key).Table.Columns
				Dim asTableColumn(1) As String
				asTableColumn(0) = key.ToUpper
				asTableColumn(1) = column.ColumnName
				dicColumns.Add(asTableColumn, column)
			Next
		Next
		Return dicColumns
	End Function
 
 
	Private Function MergeDataRowsStruture(ByVal dtbTable As DataTable, _
										   ByVal dicColumns As Collections.Generic.Dictionary(Of String(), DataColumn)) As DataTable
		Dim dtbMerge As New DataTable
 
 
		Dim lstDupColumnNames = (From dic In dicColumns _
		Group By dic.Value.ColumnName Into Group _
		Where Group.Count > 1).ToList
 
		For Each sTableColumn As String() In dicColumns.Keys
			Dim sColumnName As String = sTableColumn(1)
			Dim lnqDupColumns = lstDupColumnNames.Where(Function(column) column.ColumnName = sColumnName)
 
			If lnqDupColumns.Count > 0 Then
				dtbMerge.Columns.Add(String.Format("{0}.{1}", sTableColumn(0), sTableColumn(1)), _
								dicColumns(sTableColumn).DataType)
			Else
				dtbMerge.Columns.Add(sTableColumn(1), _
								dicColumns(sTableColumn).DataType)
			End If
 
		Next
 
 
		Return dtbMerge
	End Function
 
 
	Private Sub CopyDataToMergeTable(ByVal drwRowsToMerge As DataRow, ByRef dtbMergedTable As DataTable)
 
 
		Dim drwMerged = dtbMergedTable.NewRow
 
		For Each column As DataColumn In dtbMergedTable.Columns
			If column.ColumnName.Contains(".") Then
				Dim asTableColumn As String() = column.ColumnName.Split("."c)
				Dim sTable As String = asTableColumn(0)
				drwMerged(column.ColumnName) = CType(drwRowsToMerge(sTable), DataRow)(asTableColumn(1))
			Else
				For Each dtcColumn As DataColumn In drwRowsToMerge.Table.Columns
 
					If CType(drwRowsToMerge(dtcColumn.ColumnName), DataRow).Table.Columns.Contains(column.ColumnName) Then
						drwMerged(column.ColumnName) = CType(drwRowsToMerge(dtcColumn.ColumnName), DataRow)(column.ColumnName)
					End If
				Next
			End If
		Next
		dtbMergedTable.Rows.Add(drwMerged)
		'Return drwMerged
	End Sub
 
    Private Function MergeDataRows(ByVal ParamArray Rows As DataRow()) As DataRow
        Dim dtbMerge As New DataTable
 
        Dim dicColumns As New Collections.Generic.Dictionary(Of String(), DataColumn)
 
        Dim index As Int32
        For Each row As DataRow In Rows
            For Each column As DataColumn In row.Table.Columns
                Dim asTableColumn(1) As String
                asTableColumn(0) = index.ToString 'column.Table.TableName
                asTableColumn(1) = column.ColumnName
                dicColumns.Add(asTableColumn, column)
            Next
            index += 1
        Next
 
        Dim lstDupColumnNames = (From dic In dicColumns _
                Group By dic.Value.ColumnName Into Group _
                Where Group.Count > 1).ToList
 
        For Each sTableColumn As String() In dicColumns.Keys
            Dim sColumnName As String = sTableColumn(1)
            Dim lnqDupColumns = lstDupColumnNames.Where(Function(column) column.ColumnName = sColumnName)
 
            If lnqDupColumns.Count > 0 Then
                dtbMerge.Columns.Add(String.Format("{0}.{1}", sTableColumn(0), sTableColumn(1)), _
                                dicColumns(sTableColumn).DataType)
            Else
                dtbMerge.Columns.Add(sTableColumn(1), _
                                dicColumns(sTableColumn).DataType)
            End If
 
        Next
 
        Dim drwMerged = dtbMerge.NewRow
 
        For Each column As DataColumn In dtbMerge.Columns
            If column.ColumnName.Contains(".") Then
                Dim asTableColumn As String() = column.ColumnName.Split("."c)
                Dim iRowIndex As Int32 = CInt(asTableColumn(0))
                drwMerged(column.ColumnName) = Rows(iRowIndex)(asTableColumn(1))
            Else
                For Each row As DataRow In Rows
                    If row.Table.Columns.Contains(column.ColumnName) Then
                        drwMerged(column.ColumnName) = row(column.ColumnName)
                    End If
                Next
            End If
        Next
 
        Return drwMerged
 
    End Function
 
End Class

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309: