Hente data fra Krak til Excel

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