This is the problem:
Code:
Dim findtext As String = "(?<=<hello>)(.*?)(?=</hello>)"
Dim myregex As String = TextBox1.Text
Dim doregex As MatchCollection = Regex.Matches(myregex, findtext)
MsgBox(doregex(0).ToString)
TextBox1:
<hello>1</hello>
<hello>2</hello>
<hello>3</hello>
So, when i run the code, it shows MsgBox with 1. Why only 1? Why not 2 and 3?
I added ? to .*, but it's still the same.
The MatchCollection contains multiple items but you are only retrieving the first one with doregex(0). Use a loop to get to the others:
Dim doregex As MatchCollection = Regex.Matches(myregex, findtext)
For Each match As Match In doregex
MsgBox(match.ToString)
Next
EDIT:
To combine the values, append them to a String within the loop before you use it:
Dim doregex As MatchCollection = Regex.Matches(myregex, findtext)
Dim matches As String = "" ' consider StringBuilder if there are many matches
For Each match As Match In doregex
matches = matches + match.ToString + " "
Next
MsgBox(matches)
Because you show only the first item in MatchCollection , you can use For Each loop to show all items like this :
For Each item In doregex
MsgBox(item.ToString)
Next
You can combine items with many way, belows one of them :
Dim result As String = String.Empty
For Each item In doregex
result = String.Format("{0} {1}", result, item)
Next
MsgBox(result)
Use LINQ:
Dim text_box_text = "<hello>1</hello>" & vbLf & "<hello>2</hello>" & vbLf & "<hello>3</hello>"
Dim findtext As String = "(?<=<hello>)(.*?)(?=</hello>)"
Dim my_matches_1 As List(Of String) = System.Text.RegularExpressions.Regex.Matches(text_box_text, findtext) _
.Cast(Of Match)() _
.Select(Function(m) m.Value) _
.ToList()
MsgBox(String.Join(vbLf, my_matches_1))
Also, with this code, you do not need to use the resource-consuming lookarounds. Change the regex to
Dim findtext As String = "<hello>(.*?)</hello>"
and use .Select(Function(m) m.Groups(1).Value) instead of .Select(Function(m) m.Value).
Related
I'm using this code to filter my datatable by dataview:
Dim xBlockedAccounts As String = "1,5,7"
Dim xDv_AllAcc As New DataView(MyVar_Dt_Accounts)
xDv_AllAcc.RowFilter = "FIND_IN_SET(AccID," & xBlockedAccounts & ")"
Me.Dgv3.DataSource = xDv_AllAcc.ToTable
but it gives me that:
The expression contains undefined function call FIND_IN_SET().'
how I can use FIND_IN_SET function with Rowfilter of Dataview?
I assumed MyVar_Dt_Accounts was a DataTable. You need to have an array of blocked accounts values. Then the Linq magic.
Private Sub OPCode()
Dim MyVar_Dt_Accounts As New DataTable
Dim xBlockedAccounts = {"1", "5", "7"}
Dim dt = (From row As DataRow In MyVar_Dt_Accounts.AsEnumerable
Select row
Where xBlockedAccounts.Contains(row("AccID").ToString)).CopyToDataTable
Dgv3.DataSource = dt
End Sub
Check first that AccID is really a string in the database and not a number.
I have a string called str = "12345-5, 12345-4, 12345-3, 12345-2, 12345-1 I need to reverse the string so it looks like this str = "12345-1, 12345-2, 12345-3, 12345-4, 12345-5"
I have tried the strReverse method, and it almost did what I wanted...
Sub rev()
Dim str As String
str = "12345-5, 12345-4, 12345-3, 12345-2, 12345-1"
str = StrReverse(Trim(str))
'turns out to be str = "1-54321 ,2-54321 ,3-54321 ,4-54321 ,5-54321"
End Sub
but it ended up reversing the whole string, should have guessed that. So I'm wondering should I use a regex expression to parse the string and remove the "12345-" and then reverse it and add it back in? I'm not too sure if that would be the best method for my problem. Does anyone know a solution to my problem or could point me in the right direction? Thanks
Use Split then loop backwards through the array:
Sub rev()
Dim str As String
str = "12345-5, 12345-4, 12345-3, 12345-2, 12345-1"
Dim strArr() As String
strArr = Split(str, ",")
str = ""
Dim i As Long
For i = UBound(strArr) To LBound(strArr) Step -1
str = str & ", " & Trim(strArr(i))
Next i
str = Mid(str, 3)
Debug.Print str
End Sub
I would do it like this:
Sub TestMe()
Dim str As String
str = "12345-5, 12345-4, 12345-3, 12345-2, 12345-1"
str = StrReverse(str)
Dim myArr As Variant
myArr = Split(str, ",")
Dim newString As String
Dim myA As Variant
For Each myA In myArr
newString = newString & StrReverse(myA) & ","
Next myA
newString = Trim(Left(newString, Len(newString) - 1))
Debug.Print newString
End Sub
Getting this:
12345-1, 12345-2, 12345-3, 12345-4,12345-5
In general, this is quite popular Algorithmic problem, which used to be asked by Google for Junior Developers. Sounding like this - Efficiently reverse the order of the words (not characters) in an array of characters
i made an webrequestto get an htmlcode of an website and then i extract the
the wanted links with htmlagilitypack
like this :
'webrequest'
Dim rt As String = TextBox1.Text
Dim wRequest As WebRequest
Dim WResponse As WebResponse
Dim SR As StreamReader
wRequest = FtpWebRequest.Create(rt)
WResponse = wRequest.GetResponse
SR = New StreamReader(WResponse.GetResponseStream)
rt = SR.ReadToEnd
TextBox2.Text = rt
'htmlagility to extract the links'
Dim htmlDoc1 As New HtmlDocument()
htmlDoc1.LoadHtml(rt)
Dim links = htmlDoc1.DocumentNode.SelectNodes("//*[#id='catlist-listview']/ul/li/a")
Dim hrefs = links.Cast(Of HtmlNode).Select(Function(x) x.GetAttributeValue("href", ""))
'join the `hrefs`, separated by newline, into one string'
textbox3.text = String.Join(Environment.NewLine, hrefs)
the links are like this :
http://wantedlink1
http://wantedlink2
http://wantedlink3
http://wantedlink4
http://wantedlink5
http://wantedlink6
http://wantedlink7
Now i want to add every line in the string to listbox instead of textbox
one item for each line
THERE IS ABOUT 400 http://wantedlink
hrefs in your case already contained IEnumerable(Of String). Joining them into one string and then split it again to make it work is weird. Since String.Split() returns array, maybe you only need to project hrefs into array to make .AddRange() to work :
ListBox1.Items.AddRange(hrefs.ToArray())
Use the AddRange method of the listbox's items collection and pass it the lines array of the textbox.
AddRange
Lines
Hint: It's one line of code.
its ok i find the answer
Dim linklist = String.Join(Environment.NewLine, hrefs)
Dim parts As String() = linklist.Split(New String() {Environment.NewLine},
StringSplitOptions.None)
ListBox1.Items.AddRange(parts)
this add all the 400 links to the listbox
Is there a way of taking html code for a table and printing out the same table in a word document using VBA (VBA should be able to parse the html code block for a table)?
It is possible to take the contents of the table and copy them into a new table created in Word, however is it possible to recreate a table using the html code and vba?
For any of this, where can one begin to research?
EDIT:
Thanks to R3uK: here is the first portion of the VBA script which reads a line of html code from a file and uses R3uK's code to print it to the excel worksheet:
Private Sub button1_Click()
Dim the_string As String
the_string = Trim(ImportTextFile("path\to\file.txt"))
' still working on removing new line characters
Call PrintHTML_Table(the_string)
End Sub
Public Function ImportTextFile(strFile As String) As String
' http://mrspreadsheets.com/1/post/2013/09/vba-code-snippet-22-read-entire-text-file-into-string-variable.html
Open strFile For Input As #1
ImportTextFile = Input$(LOF(1), 1)
Close #1
End Function
' Insert R3uK's portion of the code here
This could be a good place to start, you will only need to check content after to see if there is any problem and then copy it to word.
Sub PrintHTML_Table(ByVal StrTable as String)
Dim TA()
Dim Table_String as String
Table_String = " " & StrTable & " "
TA = SplitTo2DArray(Table_String, "</tr>", "</td>")
For i = LBound(TA, 1) To UBound(TA, 1)
For j = LBound(TA, 2) To UBound(TA, 2)
ActiveSheet.Cells(i + 1, j + 1) = Trim(Replace(Replace(TA(i, j), "<td>", ""), "<tr>", ""))
Next j
Next i
End Sub
Public Function SplitTo2DArray(ByRef StringToSplit As String, ByRef RowSep As String, ByRef ColSep As String) As String()
Dim Rows As Variant
Dim rowNb As Long
Dim Columns() As Variant
Dim i As Long
Dim maxlineNb As Long
Dim lineNb As Long
Dim asCells() As String
Dim j As Long
' Split up the table value by rows, get the number of rows, and dim a new array of Variants.
Rows = Split(StringToSplit, RowSep)
rowNb = UBound(Rows)
ReDim Columns(0 To rowNb)
' Iterate through each row, and split it into columns. Find the maximum number of columns.
maxlineNb = 0
For i = 0 To rowNb
Columns(i) = Split(Rows(i), ColSep)
lineNb = UBound(Columns(i))
If lineNb > maxlineNb Then
maxlineNb = lineNb
End If
Next i
' Create a 2D string array to contain the data in <Columns>.
ReDim asCells(0 To maxlineNb, 0 To rowNb)
' Copy all the data from Columns() to asCells().
For i = 0 To rowNb
For j = 0 To UBound(Columns(i))
asCells(j, i) = Columns(i)(j)
Next j
Next i
SplitTo2DArray = asCells()
End Function
I have written a function that’s sole purpose is to loop through all forms in a continuous form, grab the names from an "Owner" field, and then create a collection out of them which only contains unique values (no repeated names).
The code below is my current code, I realize that this may seems to be a roundabout way to do what I want but some unforeseen issues prevent me from doing this the way I would like to. So while I realize the code isn't super effective (and is very rough coding) I want to finish this path if only for a learning experience. This line of code always gives me a type mismatch error message. I have used a break line to see what those variables are in the local window, they both contain a string which should be the same therefore should return true. I can't seem to find a way to make that comparison actually work.
ElseIf var = o Then
The code (heavy commenting to make sure I am clear):
Private Sub Command39_Click()
Dim intRecordCount As Integer
Dim rs As DAO.Recordset
Dim colNames As Collection
Set colNames = New Collection
Set rs = Me.RecordsetClone
intRecordCount = rs.RecordCount
DoCmd.GoToRecord , , acFirst
If intRecordCount > 0 Then
Dim thisCol As Collection
Set thisCol = New Collection
'For each record on the form
Do While Not rs.EOF
Dim str As String
Dim o As Variant
str = Me.txtOwners.Value & ""
'If the textbox isn't empty
If Len(str) > 0 Then
'Send the string containing names ("Bob, Cheryl, Jeff, Tim")
Set thisCol = SplitNames(str)
'Loop through all of the names found
For Each o In thisCol
Dim var As Variant
Dim blnFound As Boolean
'Loop through all names in the main collection
For Each var In colNames
'If the collection is empty simply add the first name
If colNames.Count = 0 Then
blnFound = False
'If the collection has items check each one to see if the name is already in the collection
'This line is where the problem lies, I can't find anyway to compare var to o
ElseIf var = o Then
blnFound = True
End If
Next var
'If the name was not found in the collection add it
If Not blnFound Then
colNames.Add (o)
End If
Next o
End If
'Go to the next record in the continuous
DoCmd.GoToRecord , , acNext
rs.MoveNext
Loop
End If
End Sub
'Accepts the name of the owners to be split
Public Function SplitNames(strNames As String) As Collection
Dim colNames As Collection
Dim strThisName As String
Set colNames = New Collection
'Replaces ("Bob, Cheryl, Jeff, Tim") with ("Bob Cheryl Jeff Tim")
'I realize this isn't really needed simply my OCD requires I do
strNames = Trim(Replace(strNames, ", ", " "))
'Create the collection of names
colNames.Add (Split(strNames, " "))
'Send back the collection
Set SplitNames = colNames
End Function
Update - For some reason I need to access the var string propery by using var(0) so it seems like somehow var became its own array?
Here's an example of modifying your SplitNames function to a Dictionary object.
WHile there is an Exists method which you may make use of elsehwere in your code, you need not use that to ensure uniqueness. Merely referring to a Key will create it, so you can create a new key (or overwrite it if it exists) using the same method:
dict(key) = value
Note that this overwrites the value portion of the Key/Value pair. But since your SplitNames function is merely building the "list" of unique names, I don't think that will be an issue. For the sake of example, I simply assign nullstring to each value.
I added an optional parameter to this function to allow you to return either a Dictionary of unique names, or a Collection (converted from the Dictionary). Untested, but I think it should work. Let me know if you have any trouble with it.
Public Function SplitNames(strNames As String, Optional returnCollection as Boolean=False) As Object
'returns a Dictionary of unique names, _
' or a Collection of unique names if optional returnCollection=True
Dim dictNames as Object
Dim strThisName As Variant
Dim coll as Collection
Set dictNames = CreateObject("Scripting.Dictionary")
'Replaces ("Bob, Cheryl, Jeff, Tim") with ("Bob Cheryl Jeff Tim")
'I realize this isn't really needed simply my OCD requires I do
strNames = Trim(Replace(strNames, ", ", " "))
'Create the collection of names
For Each strThisName in Split(strNames, " ")
dictNames(strThisName) = ""
Next
If Not returnCollection Then
Set SplitNames = dictNames
Else
Set coll = New Collection
For each strThisName in dictNames.Keys()
coll.Add strThisName
Next
Set SplitNames = coll
End If
End Function
So I think you can reduce your procedure like so:
Private Sub Command39_Click()
Dim intRecordCount As Integer
Dim rs As DAO.Recordset
Dim dictNames As Object
Dim collNames as Collection
Dim str As String
Dim o As Variant
Set rs = Me.RecordsetClone
intRecordCount = rs.RecordCount
DoCmd.GoToRecord , , acFirst
rs.MoveFirst
If intRecordCount > 0 Then
'For each record on the form
Do While Not rs.EOF
str = Me.Controls("Text27").Value & ""
'If the textbox isn't empty
If Len(str) > 0 Then
'Send the string containing names ("Bob, Cheryl, Jeff, Tim")
Set dictNames = SplitNames(str)
'Alternatively, if you want to work with the Collection instead:
Set collNames = SplitNames(str, True)
End If
Loop
End If
End Sub
The following is the updated code that works for what I need it to do. I was adding a string array (being created by the Split() function) which was what I was adding instead of the string value itself.
Private Sub Command39_Click()
Dim intRecordCount As Integer
Dim rs As DAO.Recordset
Dim dictNames As New Collection
Set rs = Me.RecordsetClone
intRecordCount = rs.RecordCount
DoCmd.GoToRecord , , acFirst
rs.MoveFirst
If intRecordCount > 0 Then
Dim dictTheseNames As New Collection
'For each record on the form
Do While Not rs.EOF
Dim str As String
Dim o As Variant
str = Me.Controls("Text27").Value & ""
'If the textbox isn't empty
If Len(str) > 0 Then
'Send the string containing names ("Bob, Cheryl, Jeff, Tim")
Set dictTheseNames = SplitNames(str)
'Loop through all of the names found
For Each o In dictTheseNames
Dim var As Variant
Dim blnFound As Boolean
blnFound = False
'Loop through all names in the main collection
For Each var In dictNames
'If the collection is empty simply add the first name
If dictNames.Count = 0 Then
dictNames.Add (o)
'If the collection has items check each one to see if the name is already in the collection
'This line is where the problem lies, I can't find anyway to compare var to o
ElseIf o = var Then
blnFound = True
End If
Next var
'If the name was not found in the collection add it
If Not blnFound Then
dictNames.Add (o)
End If
Next o
End If
'Go to the next record in the continuous
rs.MoveNext
If (rs.RecordCount - rs.AbsolutePosition) > 2 Then
DoCmd.GoToRecord , , acNext
End If
Loop
End If
End Sub
'Accepts the name of the owners to be split
Public Function SplitNames(strNames As String) As Collection
Dim dictNames As New Collection
Dim strThisName As String
Dim strArray() As String
Set dictNames = New Collection
'Replaces ("Bob, Cheryl, Jeff, Tim") with ("Bob Cheryl Jeff Tim")
'I realize this isn't really needed simply my OCD requires I do
strNames = Trim(Replace(strNames, ", ", " "))
'Create the array of names
strArray = Split(strNames, " ")
Dim o As Variant
For Each o In strArray
dictNames.Add (o)
Next o
'Send back the collection
Set SplitNames = dictNames
End Function