Probleme beim Durchführen einer Webabfrage
Sub-Verwirrt
ich habe schon viele hilfreiche Tipps in diesem Forum gefunden, bin jetzt aber leider an die Grenzen des umsetzbaren (zumindest für mich) gekommen und finde leider keinen Lösungsansatz für mein Problem.
Hab aus der Fachhochschule noch ein Excel Sheet mit dem wir Zugfahrtzeiten abgefragt haben, dieses wollte ich jetzt nutzen, um per Webabfrage, Routeninformationen herunterzuladen und aufzubereiten, um letztlich ein Sheet zur Fahrtkostenabrechnung zu erstellen. Habe mich am Aufbau des alten Sheets orientiert und versucht die Attribute entsprechend umzubenennen, so das ich sie für meine Zwecke verwenden kann. Leider scheint es bei der Übertragung der Informationen aus der Webabfrage in eine Übersichts-Arbeitsmappe Probleme zu geben und ich komme nicht auf den Fehler.
Er sagt mir immer ich hätte bestimmte Variablen nicht definiert ("Fehler beim Kompilieren"), wobei diese meiner Meinung nach nur zur optischen Aufbereitung dienen und für mich im ersten Schritt nicht so wichtig sind, wenn ich es rausnehme werden mir trotz allem keine Daten in der Arbeitsmape "Abfrageergebnis" angegezeigt. Kann mir jemand sagen, wie ich es schaffe das ich die Abfragedaten angezeigt bekomme?!
Alles weitere, also das sortieren und aufbereiten der Informationen zur Fahrtkostenabrechnung, stellt denke ich kein weiteres Problem dar.
Ich bedanke mich schon jetzt ganz herzlich für die Unterstützung.
Liebe Grüße , David
Anbei mal der Auszug aus dem VBA Editor zur Verdeutlichung, der Fehler wird mir immer nach "Sub zurSammlungZufuegen()" ausgegeben:
Option Explicit
Sub abfrageAusfuehren()
Call dbWebabfrage
Call zurSammlungZufuegen
End Sub
Public Function suchstring()
Dim maskenWerte As Variant
Dim defaultWerte As Variant
Dim abfrageFelder As Variant
Dim abfrage As String
Sheets("Anfragemaske").Activate
ActiveSheet.Calculate
maskenWerte = Array(Cells(25, 10), _
Cells(10, 3), _
Cells(11, 3), _
Cells(33, 10), _
Cells(16, 3), _
Cells(17, 3))
Sheets("Abfragefelder").Activate
abfrageFelder = Array(Cells(3, 4), _
Cells(4, 4), _
Cells(5, 4), _
Cells(6, 4), _
Cells(7, 4), _
Cells(8, 4), _
Cells(9, 4), _
Cells(10, 4))
abfrage = abfrageFelder(0) & _
abfrageFelder(1) & maskenWerte(0) & _
abfrageFelder(2) & maskenWerte(1) & _
abfrageFelder(3) & maskenWerte(2) & _
abfrageFelder(4) & maskenWerte(3) & _
abfrageFelder(5) & maskenWerte(4) & _
abfrageFelder(6) & maskenWerte(5) & _
abfrageFelder(7)
suchstring = abfrage
End Function
Sub dbWebabfrage()
Dim webString As String
webString = suchstring()
Sheets("Abfrageergebnis").Activate
'Letzte Abfragedaten löschen
Sheets("Abfrageergebnis").Select
'Application.Run "BLPLinkReset"
Cells.Select
Selection.ClearContents
Selection.QueryTable.Delete
With ActiveSheet.QueryTables.Add( _
Connection:="URL;" & webString, _
Destination:=Range("B2"))
End With
End Sub
Sub zurSammlungZufuegen()
Dim Straße(Start) As String
Dim Hausnummer(Start) As String
Dim PLZ(Start) As String
Dim Ort(Start) As String
Dim Straße(Ziel) As String
Dim Hausnummer(Ziel) As String
Dim PLZ(Ziel) As String
Dim Ort(Ziel) As String
Dim letzteSpalte As Range
Dim worein As Range
Dim zaehler1 As Integer
Dim DatAnAbArray As Variant
Sheets("Abfrageergebnis").Activate
If InStr(Cells(17, 2), " ") Then
Ort(Start) = RTrim(Left(Cells(17, 2), InStr(Cells(17, 2), " ")))
Else
Ort(Start) = Left(Cells(17, 2), InStr(Cells(17, 2), "("))
End If
If InStr(Cells(18, 2), " ") Then
Ort(Ziel) = RTrim(Left(Cells(18, 2), InStr(Cells(18, 2), " ")))
Else
Ort(Ziel) = Left(Cells(18, 2), InStr(Cells(18, 2), "(") - 1)
End If
DatAnAbArray = Array(DateValue(Right(Cells(17, 3), Len(Cells(17, 3).Value2) - 4)), _
TimeSerial(Left(Range("E17").Value2, 2), Mid(Range("E17").Value2, 4, 2), 0), _
CDate(Range("E18").Value2))
Sheets("Datensammlung").Activate
Set worein = Range("B3", Range("B4").End(xlToRight))
zaehler1 = 1
Do While worein.Value2(2, zaehler1) Ort(Start) Or worein.Value2(2, zaehler1 + 1) Ort(Ziel)
zaehler1 = zaehler1 + 1
Loop
zaehler1 = zaehler1 + 1
If Cells(5, zaehler1) = "" Then
Cells(5, zaehler1 - 1) = DatAnAbArray(0)
Cells(5, zaehler1) = DatAnAbArray(1)
Cells(5, zaehler1 + 1) = DatAnAbArray(2)
Else
'Range("A4").End(xlDown).Select
Range(Cells(4, zaehler1), Cells(4, zaehler1)).End(xlDown).Select
ActiveCell.Offset(1, -1) = DatAnAbArray(0)
Cells(ActiveCell.Row + 1, zaehler1) = DatAnAbArray(1)
Cells(ActiveCell.Row + 1, zaehler1 + 1) = DatAnAbArray(2)
End If
End Sub