Export von Webinhalt in eine Zelle

Sub Webabfrage() ' Makro1 Makro Range("A1").Select ActiveWorkbook.Worksheets.Add With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.Domain.de/", _ Destination:=Range("A1")) .Name = "www.website1.de" .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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
wollte keinen neuen Code zusammenbauen, daher habe ich diesen erweitert.

Sub Webabfrage()
Dim ArDaten, n&, nn&
With ActiveWorkbook.Worksheets.Add
With .QueryTables.Add(Connection:="URL;http://www.Domain.de/", _
Destination:=Range("A1"))
.Name = "www.website1.de"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With .Range("www.website1.de")
ArDaten = .Value
.Clear
End With
.Names("www.website1.de").Delete
For n = 1 To UBound(ArDaten)
For nn = 2 To UBound(ArDaten, 2)
ArDaten(n, 1) = ArDaten(n, 1) & ArDaten(n, nn)
Next nn
Next n
ReDim Preserve ArDaten(1 To UBound(ArDaten), 1 To 1)
ArDaten = Join(Application.Transpose(ArDaten), vbCrLf)
.Range("A1").Value = ArDaten
.Columns(1).AutoFit
End With
End Sub

Gruß Tino

Sub Webabfrage() Dim ArDaten, n&, nn&, strString$ With ActiveWorkbook.Worksheets.Add With .QueryTables.Add(Connection:="URL;http://www.Domain.de/", _ Destination:=Range("A1")) .Name = "www.website1.de" .FieldNames = False .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = False .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlEntirePage .WebFormatting = xlWebFormattingNone .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With With .Range("www.website1.de") ArDaten = .Value .Clear End With .Names("www.website1.de").Delete For n = 1 To UBound(ArDaten) For nn = 1 To UBound(ArDaten, 2) strString = strString & ArDaten(n, nn) Next nn strString = strString & vbCrLf Next n strString = Left$(strString, Len(strString) - 1) .Range("A1").Value = strString .Columns(1).AutoFit End With End Sub

Beliebteste Forumthreads (12 Monate)

Export von Webinhalt in eine Zelle

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread