AW: Fahrkostentabelle
26.10.2009 20:24:18
Nico
Hallo Jens,
danke für Deine Antwort.
Ich hab foglenden Code gefunden, der das wohl so grob erledigt. Ich hab nur leider keinerlei VBA-Kenntnisse und weiß nicht Mal wie ich diesen Code ausführen kann und wie die Tabelle aufgebaut sein muss. Mein Wunsch wäre auf Basis von SVERWEIS Start und Ziel auszuwählen und dann müsste die Webabfrage getartet werden, die mir die Entfernung in eine Zelle schreibt.
Tausen Dank,
Nico
Option Explicit
Sub Orte()
Dim i As Integer
With Sheets(1)
Zeile = .Range("A65536").End(xlUp).Row - 1
For i = 2 To Zeile
.Cells(i + 1, 4).Value = Entfernung(.Cells(i, 1), .Cells(i, 2), .Cells(i, 3), .Cells(i + 1, 1), _
.Cells(i + 1, 2), .Cells(i + 1, 3))
Next i
End With
End Sub
Function Entfernung(Von_Straße As String, Von_PLZ As String, Von_Ort As String, Nach_Straße As _
String, Nach_PLZ As String, Nach_Ort As String)
Dim IEApp As Object
Dim IEDocument As Object
Dim blnGefunden As Boolean
Dim RouteStr As String
Dim Von As String
Dim Nach As String
Dim Zeile As Long
Dim IEDoc As Object
Dim strTeile As Variant
Dim i As Long
Dim msg As String
blnGefunden = False
Von = Adresse(Von_Straße, Von_Ort, Von_PLZ)
Nach = Adresse(Nach_Straße, Nach_Ort, Nach_PLZ)
Set IEApp = CreateObject("InternetExplorer.Application")
IEApp.Visible = False
IEApp.Navigate "http://maps.google.com/maps?saddr=" & Von & "&daddr=" & Nach & "&hl=de"
Do: Loop Until IEApp.Busy = False
Set IEDocument = IEApp.Document
Set IEDoc = IEApp.Document
strTeile = Split(IEDoc.Body.innerText, vbCrLf)
For i = LBound(strTeile) To UBound(strTeile)
If InStr(1, strTeile(i), "Minuten", vbTextCompare) > 0 Then
blnGefunden = True
Entfernung = "Von: " & Von & vbLf & "Nach: " & Nach & vbLf & strTeile(i)
End If
Next
If blnGefunden = False Then
MsgBox "Die Adresse konnte nicht decodiert werden." & vbCr & "Falsche PLZ?"
Else
End If
IEApp.Quit
Set IEDocument = Nothing
Set IEApp = Nothing
End Function
Function Adresse(Street As String, City As String, ZIP As String) As String
Dim HStr As String
If Street "" Then HStr = Street & ","
If ZIP "" Then HStr = HStr & ZIP & " "
If City "" Then HStr = HStr & City
Adresse = Trim(HStr)
End Function