I have an IEnumerable(of Employee) with a ParentID/ChildID relationship with itself that I can databind to a TreeView and it populates the hierarchy perfectly. However, I want to be able to manually loop through all the records and create all the nodes programmatically so that I can change the attributes for each node based on the data for that given item/none.
Is there a tutorial out there that explains how to do this? I've seen many that use datasets and datatables but none that show how to do it in Linq to SQL (IEnumerable)
UPDATE:
Here's how I used to do it with a DataSet - I just can't seem to find how to do the same with IEnumerable.
Private Sub GenerateTreeView()
Dim ds As New DataSet()
Dim tasktree As New Task(_taskID)
Dim dt As DataTable = tasktree.GetTaskTree()
ds.Tables.Add(dt)
ds.Relations.Add("NodeRelation", dt.Columns("TaskID"), dt.Columns("ParentID"))
Dim dbRow As DataRow
For Each dbRow In dt.Rows
If dbRow("TaskID") = _taskID Then
Dim node As RadTreeNode = CreateNode(dbRow("Subject").ToString(), False, dbRow("TaskID").ToString())
RadTree1.Nodes.Add(node)
RecursivelyPopulate(dbRow, node)
End If
Next dbRow
End Sub
Private Sub RecursivelyPopulate(ByVal dbRow As DataRow, ByVal node As RadTreeNode)
Dim childRow As DataRow
Dim StrikeThrough As String = ""
Dim ExpandNode As Boolean = True
For Each childRow In dbRow.GetChildRows("NodeRelation")
Select Case childRow("StatusTypeID")
Case 2
StrikeThrough = "ActiveTask"
Case 3
StrikeThrough = "CompletedTask"
ExpandNode = False
Case 4, 5
StrikeThrough = "ClosedTask"
ExpandNode = False
Case Else
StrikeThrough = "InactiveTask"
ExpandNode = False
End Select
Dim childNode As RadTreeNode = CreateNode("<span class=""" & StrikeThrough & """>" & childRow("Subject").ToString() & "</span>", ExpandNode, childRow("TaskID").ToString())
node.Nodes.Add(childNode)
RecursivelyPopulate(childRow, childNode)
ExpandNode = True
Next childRow
End Sub
Private Function CreateNode(ByVal [text] As String, ByVal expanded As Boolean, ByVal id As String) As RadTreeNode
Dim node As New RadTreeNode([text])
node.Expanded = expanded
Return node
End Function
If you just need a way of enumerating the tree you can implement this as a generator, it might look strange, you're probably better of with a user defined enumerator but it's essentially the same thing.
public interface IGetChildItems<TEntity>
{
IEnumerable<TEntity> GetChildItems();
}
public static IEnumerable<TEntity> Flatten<TEntity>(TEntity root)
where TEntity : IGetChildItems<TEntity>
{
var stack = new Stack<TEntity>();
stack.Push(root);
while (stack.Count > 0)
{
var item = stack.Pop();
foreach (var child in item.GetChildItems())
{
stack.Push(child);
}
yield return item;
}
}
The type constraint where TEntity : IGetChildItems is just to signify that you need to abstract how to descend the hierarchy. Without the above code would not compile.
This will enumerate the tree in a breadth first fashion, it will yield the parent element first then it's children, and then the children of those children. You can easily customize the above code to achieve a different behavior.
Edit:
The yield return stuff tells the compiler that it should return a value then continue. yield is a context keyword and it's only allowed inside an iterative statement. A generator is a simple way of writing a IEnumerable data source. The compiler will build a state machine from this code and create an enumerable anonymous class. Apparently the yield keyword does not exist in VB.NET. But you can still write a class which does this.
Imports System
Imports System.Collections
Imports System.Collections.Generic
Public Class HierarchyEnumerator(Of TEntity As IGetChildItems(Of TEntity))
Implements IEnumerator(Of TEntity), IDisposable, IEnumerator
Public Sub New(ByVal root As TEntity)
Me.stack = New Stack(Of TEntity)
Me.stack.Push(root)
End Sub
Public Sub Dispose()
End Sub
Public Function MoveNext() As Boolean
Do While (Me.stack.Count > 0)
Dim item As TEntity = Me.stack.Pop
Dim child As TEntity
For Each child In item.GetChildItems
Me.stack.Push(child)
Next
Me.current = item
Return True
Loop
Return False
End Function
Public Sub Reset()
Throw New NotSupportedException
End Sub
Public ReadOnly Property Current() As TEntity
Get
Return Me.current
End Get
End Property
Private ReadOnly Property System.Collections.IEnumerator.Current As Object
Get
Return Me.Current
End Get
End Property
Private current As TEntity
Private stack As Stack(Of TEntity)
End Class
Related
I have successfully been able to serialize an entire class of properties (array, vectors of strings, integers, doubles). Deserialize also works, but I need a way to parse the returned object into the various arrays, and then set these equal to the four arrays of the same dimension.
Before, when I was using BinaryFormatter, I could simply declare mydeser As Object, deserialize into mydeser, and then pick off the arrays directly by using e.g. readarray = mydeser.array.
I did notice that a JObject is a type of dictionary, but I don't know what the keys would be or the values, which are some sort of jsonToken.
I tried using:
For each kvp as KeyValuePair(String, jsonToken) in myser
Next
but an exception was thrown. So is there a way to maybe use a key, and then the JObject's values directly into the arrays, using maybe readarray = mydeser("array") -- assuming mydeser is a dictionary?
Imports System.IO
Imports Newtonsoft.Json
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim ser As New testSer
End Sub
End Class
Public Class testSer
Public Property array As Double(,)
Public Property vector As Double()
Public Property strVec As String()
Public Property IntVec As Integer()
Sub New()
serdeser()
End Sub
Sub serdeser()
Dim r As New Random
ReDim array(1000, 1000)
ReDim vector(1000)
ReDim strVec(1000)
ReDim IntVec(1000)
For i = 1 To 1000
vector(i) = r.NextDouble
strVec(i) = "A"
IntVec(i) = r.Next(1, 100)
For j = 1 To 1000
array(i, j) = r.NextDouble
Next
Next
Dim jsonSerializer As New JsonSerializer
Dim stream As FileStream = File.Create("D:\test")
Dim writer As New StreamWriter(stream)
Dim jsonWriter As New JsonTextWriter(writer)
jsonSerializer.Serialize(jsonWriter, Me)
writer.Close()
Dim stream1 As FileStream = File.Open("D:\test", FileMode.Open, FileAccess.Read, FileShare.Read)
Dim reader As New StreamReader(stream1)
Dim jsonTextReader As New JsonTextReader(reader)
Dim mydeser As Linq.JObject
mydeser = jsonSerializer.Deserialize(jsonTextReader)
Dim readarray(1000, 1000) As Double
Dim readvector(1000) As Double
Dim readstrVec(1000) As String
Dim readIntVec(1000) As Integer
Dim mystr = DirectCast(mydeser.First, Linq.JProperty)
'readarray = mydeser.array <--need to assign "array" back into readarray
'readvector = mydeser.vector
'readstrVec = mydeser.strvec
'readarray = mydeser.intvec
reader.Close()
End Sub
End Class
A few suggestions, considering that this is a test class:
Your serialization procedure is mostly correct. It's preferable to declare the Stream objects with a Using statement, thus in case of an exception, these objects are implicitly disposed.
The deserialization becomes quite simple if you just specify the Type to deserialize to. The Type is represented by the Type of your class. You can just write (see the sample code):
Dim myObject = [JsonSerializer].Deserialize(Of [MyObjectType])([JsonTextReader])
You don't need a FileStream, StreamWriter / StreamReader already use a FileStream internally on their own. StreamWriter creates the file if it doesn't exist.
The StreamReader is initialized explicitly with Encoding.UTF8: it's the default, it's simply a remainder that this is the Encoding used and that the file is saved without BOM signature.
Call Close() on the JsonTextWriter before you exit the Using block. The behavior is determined by the AutoCompleteOnClose property, set to True by default and it's safer.
When deserializing, set the JsonTextReader's FloatParseHandling property to FloatParseHandling.Double or FloatParseHandling.Decimal. Double is actually the default, just keep this in mind, in case you need to handle Decimal values, which are otherwise deserialized as Double.
The lower bound of arrays is 0, not 1
Make your Random object a static Field. This ensures a better functionality (or, it lets the class function properly, if you want).
In the modified sample class, I've overloaded the Constructor: passing True, will call the Build() method that fills the class object with random data.
Passing False, generates an empty object.
It's not necessary to make a copy of the deserialized values, you can generate a new class object from the JsonSerializer directly. For example:
Dim jsonPath = "d:\test.json"
' Passing True to the Constuctor, calls the Build() method
Dim serTest = New SerializationTest(True)
' Serialize all property values to the specified File
serTest.Serialize(jsonPath)
' Creates a new SerializationTest objects and fills it
' deserializing the JSON previously saved calling Serialize()
Dim serTest2 = New SerializationTest(False).Deserialize(jsonPath)
You can compare the two objects, serTest and serTest2
In case a copy is needed, see at the bottom.
Modified class:
Public Class SerializationTest
Private Shared rnd As New Random()
Public Sub New()
Me.New(False)
End Sub
Public Sub New(useBuilder As Boolean)
If useBuilder Then Build()
End Sub
Public Property DblArray As Double(,)
Public Property DblVector As Double()
Public Property StringVector As String()
Public Property IntVector As Integer()
Public Sub Serialize(jsonPath As String)
Using stream As New StreamWriter(jsonPath)
Dim jWriter As New JsonTextWriter(stream)
Dim serializer As New JsonSerializer()
serializer.Serialize(jWriter, Me)
jWriter.Close()
End Using
End Sub
Public Function Deserialize(jsonPath As String) As SerializationTest
Using reader As New StreamReader(jsonPath, Encoding.UTF8)
Dim jReader As New JsonTextReader(reader) With {
.FloatParseHandling = FloatParseHandling.Double
}
Dim serializer As New JsonSerializer()
Dim deserialized = serializer.Deserialize(Of SerializationTest)(jReader)
jReader.Close()
Return deserialized
End Using
End Function
Private Sub Build()
ReDim DblArray(1000, 1000)
ReDim DblVector(1000)
ReDim StringVector(1000)
ReDim IntVector(1000)
For i = 0 To 1000
DblVector(i) = rnd.NextDouble()
StringVector(i) = $"A{i}"
IntVector(i) = rnd.Next(1, 101)
For j = 0 To 1000
DblArray(i, j) = rnd.NextDouble()
Next
Next
End Sub
End Class
If you, for some reason, want to copy the deserialized values to the initialized, but empty, class object, then change the method like this:
Public Sub Deserialize(jsonPath As String)
Using reader As New StreamReader(jsonPath, Encoding.UTF8)
Dim jReader As New JsonTextReader(reader) With {
.FloatParseHandling = FloatParseHandling.Double
}
Dim serializer As New JsonSerializer()
Dim deserialized = serializer.Deserialize(Of SerializationTest)(jReader)
jReader.Close()
Me.DblArray = deserialized.DblArray
Me.DblVector = deserialized.DblVector
Me.StringVector = deserialized.StringVector
Me.IntVector = deserialized.IntVector
deserialized = Nothing
End Using
End Sub
And change the code that fills it in:
Dim serTest = New SerializationTest(False)
serTest.Deserialize(jsonPath)
So I have a class which I am serializing to Json. All goes well, until this nested class, which gives me an System.NullReferenceException = {"Object reference not set to an instance of an object."}. When writing the code, intelisense recognizes the nested class, but obviously I'm missing a declaration somewhere.
Root class:
Public Class RootObject
Private _metadata As List(Of Metadata)
Public Property metadata() As List(Of Metadata)
Get
Return _metadata
End Get
Set(ByVal value As List(Of Metadata))
_metadata = value
End Set
End Property
Private _test_gl As List(Of TestGl)
Public Property test_gl() As List(Of TestGl)
Get
Return _test_gl
End Get
Set(ByVal value As List(Of TestGl))
_test_gl = value
End Set
End Property
End Class
Here is the TestGl class definition:
Public Class TestGl
Private _ref_key_3 As String
<JsonProperty("ref-key-3")> _
Public Property ref_key_3() As String
Get
Return _ref_key_3
End Get
Set(ByVal value As String)
_ref_key_3 = value
End Set
End Property
Private _currency_amount As CurrencyAmount
<JsonProperty("currency-amount")> _
Public Property currency_amount() As CurrencyAmount
Get
Return _currency_amount
End Get
Set(ByVal value As CurrencyAmount)
_currency_amount = value
End Set
End Property
End Class
And finally the CurrencyAmount class:
Public Class CurrencyAmount
Private _currency As String
<JsonProperty("currency")> _
Public Property currency() As String
Get
Return _currency
End Get
Set(ByVal value As String)
_currency = value
End Set
End Property
Private _amount As String
<JsonProperty("amount")> _
Public Property amount() As String
Get
Return _amount
End Get
Set(ByVal value As String)
_amount = value
End Set
End Property
End Class
Here follow the code of filling up the object with data:
Dim Root As RootObject
Dim Meta_Data As New List(Of Metadata)()
Dim Test_Gl As New List(Of TestGl)()
Root = New RootObject
Root.metadata = New List(Of Metadata)()
Root.test_gl = New List(Of TestGl)
Meta_Data = Root.metadata
Test_Gl = Root.test_gl
And here I assign values to it:
Test_Gl.Add(New AccountGl)
Test_Gl(ItemNo).ref_key_3 = "test"
Test_Gl(ItemNo).currency_amount.currency = "EUR"
Test_Gl(ItemNo).currency_amount.amount = "100"
The line where currency_amount.currency gets assigned, it goes wrong and I'm looking at it for several hours already. I don't see it.
Any input would be highly appreciated.
The properties are written in full as I need to work on this project in VS2008.
I suspect somewhere you need to initialize _currency_amount to a new instance of CurrencyAmount I don't see new CurrencyAmount anywhere.
I suspect that you don't really want to allow the currency_amount property to be set, otherwise you should have set it in your sample assignment code at the bottom. If this is the case, then you probably shouldn't even have a Set member defined for TestGl (it should be ReadOnly, which affects only currency_amount and not _currency_amount.currency). Instead you should create a default instance of CurrencyAmount and assign it to that field during the construction of TestGl. That could be as simple as changing your declaration of _currency_amount to:
Private _currency_amount As New CurrencyAmount
Alternatively, and this may be the solution you need to use with a JSON serializable object, you keep the Set member definition, and just add a line to your test code to initialize currency_amount before using it:
Test_Gl(ItemNo).currency_amount = new CurrencyAmount
I'm trying to set up a small extension of WebBrowser control as an HtmlTextBox, with limited formatting possibilities. It works for basic formatting (bold, italic, underline). But I also wanted to allow indentation in one single level, and ideally call this in a "toggle" fashion.
I noticed that when I run Document.ExecCommand("Indent", False, Nothing) it converts the <p> element into a <blockquote> element, which is exactly what I need. But a second call to the same command just adds to the indent margin, but I want to make it so that, if cursor is already inside a <blockquote> element, it will perform an "outdent" instead.
For that, I tried to query Document.ActiveElement before performing my action, but this returns always the whole <body> element, and not the specific block element in which cursor rests at that moment.
How could I accomplish that?
This is my code:
Public Class HtmlTextBox
Inherits WebBrowser
Public Sub New()
WebBrowserShortcutsEnabled = False
IsWebBrowserContextMenuEnabled = False
DocumentText = "<html><body></body></html>"
If Document IsNot Nothing Then
Dim doc = Document.DomDocument
If doc IsNot Nothing Then
doc.designMode = "On"
If Me.ContextMenuStrip Is Nothing Then
AddHandler Document.ContextMenuShowing, Sub(sender As Object, e As HtmlElementEventArgs) Application.DoEvents()
End If
End If
End If
End Sub
Private Sub HtmlTextBox_PreviewKeyDown(sender As Object, e As PreviewKeyDownEventArgs) Handles Me.PreviewKeyDown
If e.Control Then
If e.KeyData.HasFlag(Keys.B) OrElse e.KeyData.HasFlag(Keys.N) Then BoldToggle()
If e.KeyData.HasFlag(Keys.I) Then ItalicToggle()
If e.KeyData.HasFlag(Keys.S) OrElse e.KeyData.HasFlag(Keys.U) Then UnderlineToggle()
If e.KeyData.HasFlag(Keys.M) Then BlockQuoteToggle()
End If
End Sub
Public Sub BoldToggle()
Document.ExecCommand("Bold", False, Nothing)
End Sub
Public Sub ItalicToggle()
Document.ExecCommand("Italic", False, Nothing)
End Sub
Public Sub UnderlineToggle()
Document.ExecCommand("Underline", False, Nothing)
End Sub
Public Sub BlockQuoteToggle()
If Document.ActiveElement.TagName.ToLower = "blockquote" Then
Document.ExecCommand("Outdent", False, Nothing)
Else
Document.ExecCommand("Indent", False, Nothing)
End If
End Sub
End Class
The method ElementAtSelectionStart is designed to return the element containing the start of the current selection. This code is for a WebBrowser control in edit mode. Hopefully it will work for your needs.
Public Class mshtmlUtilities
Public Enum C_Bool
[False] = 0
[True] = 1
End Enum
Public Shared Function ElementAtSelectionStart(ByVal wb As System.Windows.Forms.WebBrowser) As System.Windows.Forms.HtmlElement
Dim el As System.Windows.Forms.HtmlElement = Nothing
If wb IsNot Nothing AndAlso _
wb.Document IsNot Nothing AndAlso _
DirectCast(wb.Document.DomDocument, mshtml.IHTMLDocument2).designMode.Equals("on", StringComparison.InvariantCultureIgnoreCase) Then
Dim doc As mshtml.IHTMLDocument2 = DirectCast(wb.Document.DomDocument, mshtml.IHTMLDocument2)
Dim sel As mshtml.IHTMLSelectionObject = DirectCast(doc.selection, mshtml.IHTMLSelectionObject)
Select Case sel.type.ToLowerInvariant
Case "text"
Dim rng As mshtml.IHTMLTxtRange = DirectCast(sel.createRange(), mshtml.IHTMLTxtRange)
rng.collapse(True)
el = MakeWinFormHTMLElement(rng.parentElement, wb)
Case "control"
Dim rng As mshtml.IHTMLControlRange = DirectCast(sel.createRange(), mshtml.IHTMLControlRange)
el = MakeWinFormHTMLElement(rng.item(0).parentElement, wb)
Case "none"
Dim ds As mshtml.IDisplayServices = DirectCast(doc, mshtml.IDisplayServices)
Dim caret As mshtml.IHTMLCaret = Nothing
ds.GetCaret(caret)
Dim pt As mshtml.tagPOINT
caret.GetLocation(pt, C_Bool.False)
el = wb.Document.GetElementFromPoint(New Point(pt.x, pt.y))
End Select
End If
Return el
End Function
Private Shared Function MakeWinFormHTMLElement(ByVal el As mshtml.IHTMLElement, ByVal wb As System.Windows.Forms.WebBrowser) As System.Windows.Forms.HtmlElement
Dim shimInfo As Reflection.PropertyInfo = wb.GetType.GetProperty("ShimManager", Reflection.BindingFlags.NonPublic Or Reflection.BindingFlags.Instance)
Dim shimManager As Object = shimInfo.GetValue(wb, Nothing)
Dim ciElement As Reflection.ConstructorInfo() _
= wb.Document.Body.GetType().GetConstructors(Reflection.BindingFlags.Instance Or Reflection.BindingFlags.NonPublic)
Return CType(ciElement(0).Invoke(New Object() {shimManager, el}), HtmlElement)
End Function
End Class
I am just trying to figure out the best way to deserialize a json string returned from a 3rd party api call. I read ServiceStack is fast so want to try it out. No experience and here is what I have done:
Opened Visual Studio 2013
Created new project Windows Forms Application
Installed ServiceStack.Text (based on https://servicestack.net/download)
Added a button (btnView) and textbox (txtOutput)
Add code to btnView_Click event
Private Sub btnView_Click(sender As Object, e As EventArgs) Handles btnView.Click
Me.Cursor = Cursors.WaitCursor
Dim wp As New WebPost 'this allows to pass url and return results
wp.URL = "xxxx"
Dim sJSONRetVal As String = wp.Request(String.Empty, True)
'sJSONRetVal return values looks like the following:
'{"complaints":[{"feedback_type":"abuse","subject":"Sales Agent Position"},{"feedback_type":"abuse","subject":"Sales Agent Position"}],"message":"OK","code":0}
'ServiceStack.Text example
Dim t As SMTP_Complaints = ServiceStack.Text.JsonSerializer.DeserializeFromString(Of SMTP_Complaints)(sJSONRetVal)
'For Each xi As SMTP_Complaints In t
' txtOutput.Text &= xi.mail_from & vbCrLf
'Next
wp = Nothing
txtOutput.Text = t.ToString
Me.Cursor = Cursors.Default
End Sub
Public Class SMTP_Complaints
Dim _feedback_type As String = ""
Dim _subject As String = ""
Public Property feedback_type As String
Get
Return _feedback_type
End Get
Set(value As String)
_feedback_type = value
End Set
End Property
Public Property subject As String
Get
Return _subject
End Get
Set(value As String)
_subject = value
End Set
End Property
End Class
The above doesn't seem to get any data. how would I loop through the data returned and return the data from both instances? Just not sure how I need to set this up to read the json data and then be able to output.
Based on the returned JSON of:
{"complaints":[{"feedback_type":"abuse","subject":"Sales Agent Position"},{"feedback_type":"abuse","subject":"Sales Agent Position"}],"message":"OK","code":0}
You will need two DTOs to deserialise this result.
I have used auto implemented properties here to simplify the complexity of the code. If you use an older version of VB, you'll need to expand these out to include a backing field with get and set method.
Public Class SMTP_Complaint
Public Property feedback_type As String
Public Property subject As String
End Class
Public Class SMTP_ComplaintsResponse
Public Property complaints As SMTP_Complaint()
Public Property message As String
Public Property code As Integer
End Class
You need the SMTP_ComplaintsResponse class because your complaints are wrapped in your JSON response.
Then to deserialise the response:
Dim response = JsonSerializer.DeserializeFromString(Of SMTP_ComplaintsResponse)(sJSONRetVal)
And your complaints are then accessible:
For Each complaint As var In response.complaints
Console.WriteLine("Type: {0}, Subject {1}", complaint.feedback_type, complaint.subject)
Next
I'm using List(Of T) to contains my database field (invoice_id and item_id) and want to display it in DataGridView. First, I declare each of them as a class and then add them to my list then display it in DataGridView but when I compile it, the program is not responding.
My guess is that my database source is too large, because when I change the source (database field), it worked nicely. So how do I solve this List(Of T) capacity issues?
This is my code:
Sub view()
Dim msql2 As String
msql2 = "select invoice_id, item_id from detail"
Dim arayD As New List(Of INVOICE)
CMD2 = New MySqlCommand(msql2, conn.konek)
Try
Dim res = CMD2.ExecuteReader()
Dim INVO As INVOICE = Nothing
While res.Read()
INVO = New INVOICE
With INVO
.invoice_id = hasil2.GetString("invoice_id")
.item_id = hasil2.GetString("item_id")
End With
arayD.Add(INVO)
End While
dgv.DataSource = arayD
Catch ex As Exception
MessageBox.Show("ERROR")
End Try
End Sub
Public Class INVOICE
Private _kodeF As Integer
Public Property invoice_id() As Integer
Get
Return _kodeF
End Get
Set(ByVal value As Integer)
_kodeF = value
End Set
End Property
Private _kodeBrg As String
Public Property item_id() As String
Get
Return _kodeBrg
End Get
Set(ByVal value As String)
_kodeBrg = value
End Set
End Property
End Class
if you want a fast solution then add the following line inside your While Loop :
While res.Read()
Application.DoEvents()
...
End While
Or use a BackgroundWorker as the following:
Private WithEvents bgWorker As New System.ComponentModel.BackgroundWorker
Private arayD As New List(Of INVOICE)
Sub view()
bgWorker.RunWorkerAsync()
End Sub
Private Sub bgWorker_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles bgWorker.DoWork
Dim dReader As DataReader
Using YourConnection
Using YourCommand
YourConnection.Open()
dReader = YourCommand.ExecuteReader()
If dReader.HasRows Then
While dReader.Read
arayD.Add(New INVOICE With {
.invoice_id = hasil2.GetString("invoice_id"),
.item_id = hasil2.GetString("item_id")
}
)
End While
End If
End Using
End Using
End Sub
Private Sub bgWorker_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles bgWorker.RunWorkerCompleted
MsgBox("Ready to go")
dgv.DataSource = arayD
End Sub
Also you can get the count of the result and use it with a progressbar.