Re: get text between text
Use instr() to get the position of where href begins.. then the rest is simple and straightforward..
Use mid(), right() functions to extract the data...
Re: get text between text
maybe you can manipulate those string first. you make the string to be href="karte.php?d= 279944 &c=7a" (add spaces) so you can get the string between "href="karte.php?d= " and " &c=7a" using GetBetween function..
Re: get text between text
Code:
Option Explicit
Public Function Between(Text As String, Before As String, After As String, Output() As String) As Long
Dim lngA As Long, lngB As Long, lngC As Long
Erase Output
If (LenB(Before) > 0) And (LenB(After) > 0) And (LenB(Text) > 0) Then
' reserve maximum possible items
ReDim Output(LenB(Text) \ (LenB(Before) + LenB(After)))
' find first
lngA = InStrB(Text, Before)
Do While lngA
If lngA And 1 Then
Do
' find after
lngB = InStrB(lngA + LenB(Before), Text, After)
If lngB And 1 Then
' found both, store what we got
Output(lngC) = MidB$(Text, lngA + LenB(Before), lngB - lngA - LenB(Before))
lngC = lngC + 1
' find next
lngA = InStrB(lngB + LenB(After), Text, Before)
' exit inner loop
Exit Do
ElseIf lngB > 0 Then
' invalid position, not beginning of a character, try next
lngB = InStrB(lngB + 1, Text, After)
Else
' exit both loops
lngA = 0
Exit Do
End If
Loop While lngB
ElseIf lngA > 0 Then
' invalid position, not beginning of a character, try next
lngA = InStrB(lngA + 1, Text, Before)
End If
Loop
' we are done, just need to clean up memory
If (lngC > 0) Then
' remove extra items
ReDim Preserve Output(lngC - 1)
' return number of items found
Between = lngC
Else
' return empty array (LBound = 0, UBound = -1)
Output = Split(vbNullString)
End If
End If
End Function
Private Sub Form_Load()
Dim strText As String, strData() As String
Dim lngA As Long
' open data from file
Open "C:\data.txt" For Input As #1
strText = Input(LOF(1), #1)
Close #1
' if we get more than none...
For lngA = 0 To Between(strText, "href=""karte.php?d=", "&c", strData) - 1
' print everything we got
Debug.Print strData(lngA)
Next lngA
End Sub
Yes, this was easy enough for me to do, otherwise wouldn't have bothered :)
Edit!
Updated Strings.bas in my public Modules folder.
Re: get text between text
Perhaps use Instr() or InstrB() can save a few miliseconds, but this is a shortest and simple way (7 lines of main code):
Code:
Sub GetArrayBetween()
Const Tag1 = "href=""karte.php?d="
Const Tag2 = "&c"
Dim sItem() As String, i As Long
1 Open "C:\VBF\data.txt" For Input As #1
2 sItem = Split(Input(LOF(1), 1), Tag1)
3 Close #1
'-- extract each number and use
4 For i = 1 To UBound(sItem) '-- (i - 1) is used to remove the first item (0)
5 sItem(i - 1) = Split(sItem(i), Tag2, 2)(0)
6 Next
7 ReDim Preserve sItem(UBound(sItem) - 1) '-- one item short
For i = 0 To UBound(sItem)
Debug.Print sItem(i)
Next
End Sub
Re: get text between text
Quote:
Originally Posted by
Merri
Code:
Option Explicit
Public Function Between(Text As String, Before As String, After As String, Output() As String) As Long
Dim lngA As Long, lngB As Long, lngC As Long
Erase Output
If (LenB(Before) > 0) And (LenB(After) > 0) And (LenB(Text) > 0) Then
' reserve maximum possible items
ReDim Output(LenB(Text) \ (LenB(Before) + LenB(After)))
' find first
lngA = InStrB(Text, Before)
Do While lngA
If lngA And 1 Then
Do
' find after
lngB = InStrB(lngA + LenB(Before), Text, After)
If lngB And 1 Then
' found both, store what we got
Output(lngC) = MidB$(Text, lngA + LenB(Before), lngB - lngA - LenB(Before))
lngC = lngC + 1
' find next
lngA = InStrB(lngB + LenB(After), Text, Before)
' exit inner loop
Exit Do
ElseIf lngB > 0 Then
' invalid position, not beginning of a character, try next
lngB = InStrB(lngB + 1, Text, After)
Else
' exit both loops
lngA = 0
Exit Do
End If
Loop While lngB
ElseIf lngA > 0 Then
' invalid position, not beginning of a character, try next
lngA = InStrB(lngA + 1, Text, Before)
End If
Loop
' we are done, just need to clean up memory
If (lngC > 0) Then
' remove extra items
ReDim Preserve Output(lngC - 1)
' return number of items found
Between = lngC
Else
' return empty array (LBound = 0, UBound = -1)
Output = Split(vbNullString)
End If
End If
End Function
Private Sub Form_Load()
Dim strText As String, strData() As String
Dim lngA As Long
' open data from file
Open "C:\data.txt" For Input As #1
strText = Input(LOF(1), #1)
Close #1
' if we get more than none...
For lngA = 0 To Between(strText, "href=""karte.php?d=", "&c", strData) - 1
' print everything we got
Debug.Print strData(lngA)
Next lngA
End Sub
Yes, this was easy enough for me to do, otherwise wouldn't have bothered :)
Edit!
Updated
Strings.bas in my public
Modules folder.
this worked great for me, thanks :)
Re: get text between text
Quote:
Originally Posted by
anhn
Perhaps use Instr() or InstrB() can save a few miliseconds, but this is a shortest and simple way (7 lines of main code):
Code:
Sub GetArrayBetween()
Const Tag1 = "href=""karte.php?d="
Const Tag2 = "&c"
Dim sItem() As String, i As Long
1 Open "C:\VBF\data.txt" For Input As #1
2 sItem = Split(Input(LOF(1), 1), Tag1)
3 Close #1
'-- extract each number and use
4 For i = 1 To UBound(sItem) '-- (i - 1) is used to remove the first item (0)
5 sItem(i - 1) = Split(sItem(i), Tag2, 2)(0)
6 Next
7 ReDim Preserve sItem(UBound(sItem) - 1) '-- one item short
For i = 0 To UBound(sItem)
Debug.Print sItem(i)
Next
End Sub
thanks for the shorter version :)
i guess i will use this cause this one also is faster.
Re: get text between text
ive got a new small problem wich i hope you can help me with.
now it gives al the numbers, but it would be better (to make my app faster) if it only gives the numbers where "tilte" is not empty.
hopefully you can also help me with this :)
Thanks
ps youre great :)
Re: get text between text
Just to point it out, anhn's code will give invalid results if there are more of the first tag than the last tag. It would need to check whether the UBound of the second tag Split is 1. If it is 0, no second tag was found and thus it should not be added into the array.
Edit!
Updating for the title parsing:
Code:
Private Sub Form_Load()
Dim strText As String, strData() As String, strRow() As String
Dim lngA As Long
' open data from file
Open "C:\data.txt" For Input As #1
strText = Input(LOF(1), #1)
Close #1
' if we get more than none...
For lngA = 0 To Between(strText, " title=""", "&c", strData) - 1
strRow = Split(strData(lngA), """ href=""karte.php?d=", 2)
If LenB(strRow(0)) Then Debug.Print strRow(1), strRow(0)
Next lngA
End Sub
Edit #2!
anhn's suggestion functionalized and fixed the issue:
Code:
Public Function Between(Text As String, Before As String, After As String, Output() As String) As Long
Dim lngA As Long, strBetween() As String
Output = Split(Text, Before)
For lngA = 1 To UBound(Output)
strBetween = Split(Output(lngA), After, 2)
If UBound(strBetween) = 1 Then
Output(Between) = strBetween(0)
Between = Between + 1
End If
Next lngA
If Between > 0 Then
ReDim Preserve Output(Between - 1)
Else
Output = Split(vbNullString)
End If
End Function
Re: get text between text
Quote:
Originally Posted by
Merri
Just to point it out, anhn's code will give invalid results if there are more of the first tag than the last tag. It would need to check whether the UBound of the second tag Split is 1. If it is 0, no second tag was found and thus it should not be added into the array.
Have you actually test that?
With the second Split(), you always pick the first item (0) so you never have problem even Tag2 is missing. If Tag2 is missing, the full item will be picked.
Re: get text between text
I consider the tag2 missing an error, because the result isn't between two tags if the second tag is missing.
Edit!
Not to say that would be a problem in this case when both tags always exist, but I also think it needs to be pointed out just in case someone will use the same code in their own program after reading this thread :)
Re: get text between text
Quote:
Originally Posted by
Merri
Just to point it out, anhn's code will give invalid results if there are more of the first tag than the last tag. It would need to check whether the UBound of the second tag Split is 1. If it is 0, no second tag was found and thus it should not be added into the array.
Edit!
Updating for the title parsing:
Code:
Private Sub Form_Load()
Dim strText As String, strData() As String, strRow() As String
Dim lngA As Long
' open data from file
Open "C:\data.txt" For Input As #1
strText = Input(LOF(1), #1)
Close #1
' if we get more than none...
For lngA = 0 To Between(strText, " title=""", "&c", strData) - 1
strRow = Split(strData(lngA), """ href=""karte.php?d=", 2)
If LenB(strRow(0)) Then Debug.Print strRow(1), strRow(0)
Next lngA
End Sub
Edit #2!
anhn's suggestion functionalized and fixed the issue:
Code:
Public Function Between(Text As String, Before As String, After As String, Output() As String) As Long
Dim lngA As Long, strBetween() As String
Output = Split(Text, Before)
For lngA = 1 To UBound(Output)
strBetween = Split(Output(lngA), After, 2)
If UBound(strBetween) = 1 Then
Output(Between) = strBetween(0)
Between = Between + 1
End If
Next lngA
If Between > 0 Then
ReDim Preserve Output(Between - 1)
Else
Output = Split(vbNullString)
End If
End Function
thanks for your code again :)
a new problem is that i cant get the results into text1.text
how can i do this?
thanks:)
