Webabfrage
24.05.2015 07:19:18
chito
mit folgendem Code erstelle ich 80 Tabellen durch eine Webabfrage.
Die so erzeugten Tabellen möchte ich Umbennen dafür gibt es in der Tabelle(Auswertung ) in _ Zelle A1:A100 Namen dafür ist es überhaupt möglich, das gleichzeitig beim erstellen der Namen geändert wird ?
Sub Makro1()
Dim wksListeLinks As Worksheet, lngZeile As Long
Dim strLink As String, strcon As String
Dim wbZiel As Workbook, wksZiel As Worksheet, iCount As Integer
Dim strName As String
'on error resume next
Set wksListeLinks = ActiveSheet
With wksListeLinks
lngZeile = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
Set wbZiel = ActiveWorkbook
Set wksZiel = ActiveSheet
For lngZeile = 1 To lngZeile 'Startzeile der Liste ggf. anpassen!
iCount = iCount + 1
If wbZiel Is Nothing Then
Application.Workbooks.Add
Set wbZiel = ActiveWorkbook
Set wksZiel = wbZiel.Worksheets(1)
Else
Set wksZiel = wbZiel.Worksheets.Add(after:=wksZiel)
End If
strLink = wksListeLinks.Cells(lngZeile, 4)
strcon = "URL;" & strLink
strName = strLink
With wksZiel.QueryTables.Add(Connection:=strcon, _
Destination:=wksZiel.Range("A1"))
.Name = strName
.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
If iCount = 1 Then '50 = max. Anzahl Tabellenblätter (Abfragen) pro Arbeitsmappe
'für den Max-Wert sind Werte von 1 bis ca. 250 (Excel 2003) zulässig.
iCount = 0
Set wbZiel = Nothing
End If
Next lngZeile
End Sub
Gruß
chito