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