Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1236to1240
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Wenn Bedingung für webabfrage

Wenn Bedingung für webabfrage
Ralf
Hallo Forum,
ich möchte mittels einer Webanfrage Daten in eine Tabelle importieren.
Da ich sicherstellen möchte, dass eine Internetverbindung aktiv ist, habe ich eine Dummy Verbindung vorgeschaltet.
Jetzt benötige ich eine Wenn Abfrage nach der Dummy Abfrage "Call Gold":
Wenn Zelle Devisen2.B35 leer ist, soll das Makro beendet werden.
Wenn Zelle Devisen2.B35 mit einem Wert befüllt ist, soll das Makro fortgeführt werden.
Das Makro sieht derzeit so aus:
Sub EUR_USD()
'Dummy Abfrage
Call Gold
'alte Werte löschen
Sheets("Devisen").Select
Range("A2:C25").Select
Selection.ClearContents
Range("H2:J23").Select
Selection.ClearContents
Range("A1").Select
'neue Werte importieren
Call EUR
Call USD
'angelegte Verbindungen löschen
ActiveWorkbook.Connections("Verbindung").Delete
ActiveWorkbook.Connections("Verbindung1").Delete
ActiveWorkbook.Connections("Verbindung2").Delete
Sheets("Sekof Umlage").Select
Range("A1").Select
End Sub
Vielen Dank im Voraus für Eure Hilfe.
Viele Grüße
Ralf
AW: Wenn Bedingung für webabfrage
22.11.2011 11:32:06
marcl
Hallo Ralf,
in Deinem Code ist etwas .Select. Das kann man auch weglassen:
Sub EUR_USD()
'Dummy Abfrage
Call Gold
' wenn Zelle B 35 im Blatt Devisen2 nicht leer ist
If Sheets("Devisen2!).Range("B35")  "" then
'alte Werte löschen
Sheets("Devisen").Range("A2:C25").ClearContents
Range("H2:J23").ClearContents
Range("A1").Select
'neue Werte importieren
Call EUR
Call USD
'angelegte Verbindungen löschen
ActiveWorkbook.Connections("Verbindung").Delete
ActiveWorkbook.Connections("Verbindung1").Delete
ActiveWorkbook.Connections("Verbindung2").Delete
Sheets("Sekof Umlage").Select
Range("A1").Select
' sonst Fehlermeldung ausgeben
Else
MsgBox("Keine Daten in Zelle B35 vorhanden!")
End If
End Sub

Anzeige
AW: Wenn Bedingung für webabfrage
22.11.2011 11:53:45
Ralf
Hallo Marcl,
vielen Dank für Deine Lösung.
Ich habe es gerade ohne Internetverbindung ausprobiert.
Was ich nicht berücksichtigt habe ist, dass der Befehl "Call Gold" ja schon mit einer Fehlermeldung abgebrochen wird und es somit zu der Prüfung gar nicht kommt.
Hast Du einen Tipp, wie ich das jetzt lösen kann, ob eine Internetverbindung besteht?
Vielen Dank im Voraus für eine Rückmeldung.
Viele Grüße
Ralf
AW: Wenn Bedingung für webabfrage
22.11.2011 12:24:56
Rudi
Hallo,
Option Explicit
Public myERR As Integer
Sub Gold()
On Error GoTo ErrHandler
'Code
ErrHandler:
myERR = Err.Number
End Sub
Sub EUR_USD()
'Dummy Abfrage
Call Gold
If myERR > 0 Then
MsgBox "Kein I-Net", , "Gebe bekannt ..."
Exit Sub
End If
'alte Werte löschen
End Sub

Gruß
Rudi
Anzeige
AW: Wenn Bedingung für webabfrage
22.11.2011 14:44:50
Ralf
Hallo Rudi,
vielen Dank für Deinen Input.
Nur, wo gehören die einzelnen Fragmente in dem Workbook hin?
Ich habe jetzt folgendes gemacht:
Option Explicit
Public myERR As Integer
=> Ins Modul
Sub Gold()
On Error GoTo ErrHandler
'Code
ErrHandler:
myERR = Err.Number
End Sub
=> Ins Modul, an das Makro für die Webanfrage angehängt
Das sieht dann so aus:
Sub Gold()
' Gold Aktualisierung
'--- Bildschirmaktualisierung aus
Application.ScreenUpdating = False
Sheets("Devisen").Select
Range("A32").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://link", Destination:= _
Range("$A$32"))
.Name = "Gold"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
On Error GoTo ErrHandler
'Code
ErrHandler:
myERR = Err.Number
End Sub
dann.....
Sub EUR_USD()
'Dummy Abfrage
Call Gold
If myERR > 0 Then
MsgBox "Kein I-Net", , "Gebe bekannt ..."
Exit Sub
End If
'alte Werte löschen
End Sub
=> Ins Modul, an das Makro für die Webanfrage angehängt
Das sieht dann so aus:
Sub EUR_USD()
'--- Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'Dummy Abfrage
Call Gold
If myERR > 0 Then
MsgBox "Kein I-Net", , "Gebe bekannt ..."
Exit Sub
End If
'alte Werte löschen
Sheets("Devisen").Select
Range("A2:C25").Select
Selection.ClearContents
Range("H2:J23").Select
Selection.ClearContents
Range("A1").Select
'neue Werte importieren
Call EUR
Call USD
'angelegte Verbindungen löschen
ActiveWorkbook.Connections("Verbindung").Delete
ActiveWorkbook.Connections("Verbindung1").Delete
ActiveWorkbook.Connections("Verbindung2").Delete
Sheets("Sekof Umlage").Select
Range("A1").Select
End Sub
Ich hoffe Du kannst mir helfen, weil aktuell funktioniert es noch nicht.
Viele Grüße
Ralf
Anzeige
AW: Wenn Bedingung für webabfrage
22.11.2011 14:57:01
Rudi
Hallo,
On Error GoTo ErrHandler gehört natürlich in Gold an den Anfang der Prozedur.
Sub Gold()
' Gold Aktualisierung
'--- Bildschirmaktualisierung aus
Application.ScreenUpdating = False
On Error GoTo ErrHandler
End Sub
Gruß
Rudi
AW: Wenn Bedingung für webabfrage
22.11.2011 15:05:02
Ralf
Hallo Rudi,
hm, geht immer noch nicht.
Der Code sieht jetzt so aus:
Sub Gold()
' Gold Aktualisierung
'--- Bildschirmaktualisierung aus
Application.ScreenUpdating = False
On Error GoTo ErrHandler
'Code
ErrHandler:
myERR = Err.Number
Sheets("Devisen").Select
Range("A32").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://link", Destination:= _
Range("$A$32"))
.Name = "Gold"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
 .Refresh BackgroundQuery:=False
End With
End Sub
Es wird ein Laufzeitfehler 1004 ausgegeben und der ".Refresh BackgroundQuery:=False" Befehl ist gelb hinterlegt.
Was mache ich falsch?
Rückmeldung wäre nett.
Viele Grüße
Ralf
Anzeige
AW: Wenn Bedingung für webabfrage
22.11.2011 21:24:16
Ralf
Hallo Rudi und Marcl,
ich habe das noch mal in einer Dummy Datei zusammengefasst.
https://www.herber.de/bbs/user/77608.xlsm
Irgendwie kommt die MSG Box nicht, falls keine Internetverbindung besteht.
Ich möchte die Goldabfrage als zwischengeschaltete Abfrage nutzen, um zu prüfen, ob eine Internetverbindung besteht.
Wenn die Zelle A3 leer bleibt (keine Internetverbindung) sollen die anderen beiden eigentlichen Abfragen nicht starten.
Ich komme irgendwie mit meinem Halbwissen bezgl. VBA nicht weiter. Aber mich lässt es auch nicht mehr los.
Viele Grüße
Ralf
Anzeige
AW: Wenn Bedingung für webabfrage
22.11.2011 23:14:41
Rudi
Hallo,
da ist nichts von dem drin, was ich dir geschrieben habe!
Public myErr as integer
Sub Gold()
' Gold Aktualisierung
'--- Bildschirmaktualisierung aus
Application.ScreenUpdating = False
On Error GoTo ErrHandler
Sheets("Devisen").Select
Range("A32").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://link", Destination:= _
Range("$A$32"))
.Name = "Gold"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
ErrHandler:
myERR = Err.Number
End Sub

Gruß
Rudi
Anzeige
AW: Wenn Bedingung für webabfrage
23.11.2011 06:38:48
Ralf
Hallo Rudi,
ich habe den Vorschlag von Marcl eingearbeitet.
In der neu angehängten Datei habe ich versucht Deinen Vorschlag umzusetzen.
Die direkte Abfrage funktioniert. Der "Umweg" über die Dummy Abfrage nicht. Hier erscheint jetzt immer "Kein I-net".
Hier der Link:
https://www.herber.de/bbs/user/77612.xlsm
Viele Grüße
Ralf
Datei tut's nicht. owT
23.11.2011 11:25:17
Rudi
alles was nötig ist, ...
23.11.2011 22:36:32
Rudi
Hallo,
steht in diesem Thread. Lies ihn aufmerksam, denke nach und experimentiere.
Gruß
Rudi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige