AW: Eingabe einer neuen URL für Webabfrage
Michael
Hallo! Ich als nicht VBA habe mich dusselig versucht. Super KLAPPT OHNE MURREN! DANKE!!!
Nur durch Fehler lernt man. (Sollte wenigstens so sein;-))
Wo liegt der Fehler. Bin ein Anfänger mit VBA!
Sub Makro1()
Dim URL As String
strHTTP = InputBox("Enter full HTTP path ", "Daten einlesen")
With ActiveSheet.QueryTables.Add(Connection:= _
URL _
, Destination:=range("A1"))
.Name = "main"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
' falscher Versuch
'
Sub AbfrageMitURL()
'Dim URL As String
'Dim range As range
'URL = "URL;http://"
& range("A1").Value
'range("A2").Select
'With Selection.QueryTable
'.Connection = URL
'.WebSelectionType = xlSpecifiedTables
'.WebFormatting = xlWebFormattingNone
'.WebTables = "4"
'.WebPreFormattedTextToColumns = True
'.WebConsecutiveDelimitersAsOne = True
'.WebSingleBlockTextImport = False
'.WebDisableDateRecognition = False
'.WebDisableRedirections = False
'.Refresh BackgroundQuery:=False
'End With
'End Sub
Das hier hab ich aus dem Netz gezogen, klappt nicht warum?
Sub Aktienkurs_Abrufen()
Dim wName$, WKN$
Application.ScreenUpdating = False
WKN = InputBox("WKN-Nr.:", "Web-Abfrage", 879530)
If WKN = "" Then Exit Sub
wName = "http://de.finance.yahoo.com/q?s="
& _
WKN & ".f"
Worksheets.Add after:=Worksheets(Worksheets.Count)
WebAufruf wName, ActiveSheet
Worksheets("Daten").range("A2:G2").Value = range("A17:G17").Value
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Worksheets("Daten").Select
range("A1").Select
Columns("A:G").AutoFit
End Sub
Function WebAufruf(wName$, TB As Worksheet)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & wName, _
Destination:=range("A1"))
.FieldNames = False
.RefreshStyle = xlInsertDeleteCells
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.HasAutoFormat = True
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SavePassword = False
.SaveData = True
End With
End Function