Nedenstående er blevet brugt til dgs.dk som er næsten identisk med krak.dk. Har udbygget en funktion, så den frasortere alle intetsigende resultater, som dgs.dk / krak.dk har lavet for at kunderne fremgår i oftere søgerelationer. Har selv brugt nedenstående i forbindelse med et faktueringssystem, hvor nye debitorer nemt kan søges direkte igennem applikationen.
Nedenstående skal placeres i et module, og du skal blot lave en standard procedure som deklarer strSearchName (dit ønskede søgemål)
Sub NavigateTo118(ByVal strSearchName As String)
' Go the the correct site, and open display InternetExplorer.
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Dim strData As String '1. Declare a string (strData), which collects all HTML-related elements from the page.
Dim varDataArray As Variant '2. Declare a array as variant. Using a Split function, which returns a zero-based one-dimensional array.
Dim intArrayCount As Integer '3. Declare a countingfuntion as integer. Looping through all innerHTML-data.
Dim strResultDebitor As String 'Split data into a string, so the data is easy to use.
Dim strResultPhone As String 'Split data into a string, so the data is easy to use.
Dim strResultAdress As String 'Split data into a string, so the data is easy to use.
Dim strResultArea As String 'Split data into a string, so the data is easy to use.
Dim strResultCity As String 'Split data into a string, so the data is easy to use.
Dim strResultAreaCode As String 'Split data into a string, so the data is easy to use.
Dim intCArrPhoneNum As Integer 'The phonenumber is placed in various locations. Use a loop to find the right placement.
Dim intCResults As Integer 'Declare a counterfunction (integer) to sumerious the number of collections.
Dim intLenResultCity As Integer 'The areacode and city is associated, which means we have to seperate them.
intCResults = 1
intCResultsPosition = 0
frm_T1_Kundeoplysninger.lstSearchDebitor.Clear
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Call ProcessBar(frm_T1_Kundeoplysninger, strStep:="Forbinder til
http://dgs.dk...", intStep:=1, intStepTotal:=3)
Set ieApp = New InternetExplorer 'Starting InternetExplorer.
ieApp.Visible = False 'Assign True if u want to see InternetExplorer work. False will hide InternetExplorer
ieApp.Navigate "
http://degulesider.dk/" & strSearchName & "/søg.cs" 'Declare your navigation.
Do While ieApp.Busy: DoEvents: Loop 'Await untill site is fully loaded.
Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop 'Await untill site is fully loaded.
Set ieDoc = ieApp.document 'Assign page.
Call ProcessBar(frm_T1_Kundeoplysninger, strStep:="Søger efter debitorer...", intStep:=2, intStepTotal:=3)
Retry:
On Error GoTo Retry
strData = ieDoc.body.innerText
If strData <> vbNullString Then
varDataArray = Split(strData, vbCrLf) 'Split Data into separate lines, and declare each line into a array.
If UBound(varDataArray) < 80 Then GoTo Retry
For intArrayCount = 0 To UBound(varDataArray)
If intCResults < 9 Then
If InStr(1, varDataArray(intArrayCount), intCResults & ". ") > 0 Then
If InStr(1, UCase(varDataArray(intArrayCount + 1)), UCase(strSearchName)) > 0 Then
For intCArrPhoneNum = 1 To 8
If Len(varDataArray(intArrayCount + 1 + intCArrPhoneNum)) = 12 Then
intCResults = intCResults + 1
intCResultsPosition = intCResultsPosition + 1
strResultDebitor = varDataArray(intArrayCount + 1)
strResultPhone = varDataArray(intArrayCount + 1 + intCArrPhoneNum)
strResultAdress = varDataArray(intArrayCount + 2 + intCArrPhoneNum)
If varDataArray(intArrayCount + 3 + intCArrPhoneNum) = vbNullString Then
intLenResultCity = Len(varDataArray(intArrayCount + 4 + intCArrPhoneNum))
strResultAreaCode = Left(varDataArray(intArrayCount + 4 + intCArrPhoneNum), 4)
strResultCity = Right(varDataArray(intArrayCount + 4 + intCArrPhoneNum), intLenResultCity - 5)
Else
intLenResultCity = Len(varDataArray(intArrayCount + 3 + intCArrPhoneNum))
strResultAreaCode = Left(varDataArray(intArrayCount + 3 + intCArrPhoneNum), 4)
strResultCity = Right(varDataArray(intArrayCount + 3 + intCArrPhoneNum), intLenResultCity - 5)
End If
Call DebitorResults(strResultDebitor, strResultAdress, strResultAreaCode, strResultCity, strResultPhone)
Exit For
End If
Next intCArrPhoneNum
Else
If intCResults = 1 Then
If InStr(1, UCase(varDataArray(intArrayCount + 1)), UCase(strSearchName)) = 0 Then
For intCArrPhoneNum = 1 To 8
If Len(varDataArray(intArrayCount + 1 + intCArrPhoneNum)) = 12 Then
intCResults = intCResults + 1
intCResultsPosition = intCResultsPosition + 1
strResultDebitor = varDataArray(intArrayCount + 1)
strResultPhone = varDataArray(intArrayCount + 1 + intCArrPhoneNum)
strResultAdress = varDataArray(intArrayCount + 2 + intCArrPhoneNum)
If varDataArray(intArrayCount + 3 + intCArrPhoneNum) = vbNullString Then
intLenResultCity = Len(varDataArray(intArrayCount + 4 + intCArrPhoneNum))
strResultAreaCode = Left(varDataArray(intArrayCount + 4 + intCArrPhoneNum), 4)
strResultCity = Right(varDataArray(intArrayCount + 4 + intCArrPhoneNum), intLenResultCity - 5)
Else
intLenResultCity = Len(varDataArray(intArrayCount + 3 + intCArrPhoneNum))
strResultAreaCode = Left(varDataArray(intArrayCount + 3 + intCArrPhoneNum), 4)
strResultCity = Right(varDataArray(intArrayCount + 3 + intCArrPhoneNum), intLenResultCity - 5)
End If
Call DebitorResults(strResultDebitor, strResultAdress, strResultAreaCode, strResultCity, strResultPhone)
Exit For
End If
Next intCArrPhoneNum
End If
End If
End If
End If
Else
Exit For
End If
Next intArrayCount
ieApp.Quit 'Close IE
If intCResultsPosition = 0 Then
Call ProcessBar(frm_T1_Kundeoplysninger, strStep:="Fandt desværre ingen resultater" & intCResultsPosition, intStep:=3, intStepTotal:=3)
ElseIf intCResultsPosition >= 1 Then
Call ProcessBar(frm_T1_Kundeoplysninger, strStep:="Antal søgeresultater: " & intCResultsPosition, intStep:=3, intStepTotal:=3)
End If
Else
Exit Sub
End If
Ny bruger
Nybegynder
Opret
Preview
