AW: iqy-Webrequest mit Makro editieren
16.01.2007 16:43:25
fcs
Hallo Netshark,
das kann man etwa mit folgendem Makro ereichen. Die IQY-Datei wird zuerst aktualisiert.
Danach wir die Abfrage in einem neuen Blatt aktualisert. Dafür gibt es die beiden im Code dargestellten möglichkeiten.
Datei und Tabellennamen muss du entsprechend anpassen.
Gruß
Franz
Sub WebAbfrageAktualisieren()
' WebAbfrageAktualisieren Makro
Dim Dummy As String, Zeichen() As String, I As Long, FF As Integer, Datei As String
Dim wksTab As Worksheet, wksKopie As Worksheet
'iqy-Datei aktualisieren
FF = FreeFile
Datei = "C:\Programme\MSOffice\OFFICE11\QUERIES\Test.iqy"
Open Datei For Input As #FF
'Alle Daten einlesen
ReDim Zeichen(0 To 0)
I = 0
Do Until EOF(FF)
Line Input #FF, Dummy
I = I + 1
ReDim Preserve Zeichen(0 To I)
If Left(Dummy, 5) = <a href=""http:"">"http:"</a> Then
Dummy = <a href=""http://meineseite.php?group=All&tool_id=&fac=%25&start_date="">"http://meineseite.php?group=All&tool_id=&fac=%25&start_date="</a> & Format(Date - 6, "DD.MM.YY") & "&end_date=" & Format(Date, "DD.MM.YY")
End If
Zeichen(I) = Dummy
Loop
Close #FF
Open Datei For Output As #FF
For I = 1 To UBound(Zeichen)
Print #FF, Zeichen(I)
Next
Close #FF
'Neues Tabellenblatt mit aktualisierter Abfrage erstellen
'Blatt mit Abfrage kopieren
Set wksTab = Sheets("Abfrage")
wksTab.Copy Before:=Sheets(1)
'Web-Abfrage in Kopie aktualiseren
Set wksKopie = ActiveSheet
wksKopie.Range("A3").QueryTable.Refresh BackgroundQuery:=False
'Kopie neu benennen
wksKopie.Name = wksTab.Name & Format(Date, "YYYYMMDD")
'oder so (neue leere Tabelle einfügen und Abfrage einfügen
Sheets.Add
Set wksKopie = ActiveSheet
With ActiveSheet.QueryTables.Add(Connection:= _
"FINDER;C:\Programme\MSOffice\OFFICE11\QUERIES\Test.iqy" _
, Destination:=Range("A1"))
.Name = "Test"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
'Kopie neu benennen
wksKopie.Name = wksTab.Name & Format(Date, "YYYYMMDD")
End Sub