Hente csv fil fra hjemmeside.

Forslag:
Koden indsættes under Ark1 - 3 kolonner kopieres til Ark2
Udarbejdet i Excel 2007


Const søgeOrd = " Download"
Public Sub hentFraWWW()
Dim sidsteRække As Long, sidsteKolonne As Long
Dim basisCelle, basiskolonne, pctRække As Long, pctKolonne, førstePct As Long, sidstePct As Long
    Application.ScreenUpdating = False

Rem slet gl. indhold
    ActiveSheet.Cells.ClearContents
   
Rem hent fra WWW
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.invescopowershares.com/products/holdings.aspx?ticker=QQQ", _
        Destination:=Range("$A$1"))
        .Name = "holdings.aspx?ticker=QQQ"
        .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
   
    sidsteRække = ActiveCell.SpecialCells(xlLastCell).Row
    sidsteKolonne = ActiveCell.SpecialCells(xlLastCell).Column
   
    basisCelle = findCelleAdr(søgeOrd, "A1:IV" & sidsteRække)              'med teksten "Download"
   
    If basisCelle <> "" Then
        Range(basisCelle).Select
        basiskolonne = konverterTilBogstav(Selection.Column)
        pctKolonne = konverterTilBogstav(Selection.Offset(0, 2).Column)
        pctRække = Selection.Row
       
        førstePct = findCelleRæk("%", pctKolonne & CStr(pctRække) & ":" & pctKolonne & CStr(sidsteRække))
        sidstePct = søgSidstePct(pctKolonne & CStr(sidsteRække))
       
        Range(basiskolonne & førstePct & ":" & pctKolonne & sidstePct).Select
        Selection.Copy
       
Rem 3 kolonner kopieres til ark2
        Worksheets("Ark2").Activate
        ActiveSheet.Range("A1").Select
        ActiveSheet.Paste
       
        Application.CutCopyMode = False
        ActiveSheet.Range("A1").Select
       
        Application.ScreenUpdating = True
    End If
End Sub
Private Function findCelleAdr(søgEfter, område)
    With ActiveSheet.Range(område)
        Set c = .Find(søgEfter, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findCelleAdr = c.Address
        Else
            findCelleAdr = ""
        End If
    End With
End Function
Private Function findCelleRæk(søgEfter, område)
    With ActiveSheet.Range(område)
        Set c = .Find(søgEfter, LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
            findCelleRæk = c.Row
        Else
            findCelleRæk = ""
        End If
    End With
End Function
Private Function konverterTilBogstav(kolonneNr)
Dim adr As String, p As Integer
   
    adr = Mid(ActiveSheet.Cells(1, kolonneNr).Address, 2)
    p = InStr(adr, "$")
    If p > 0 Then
        konverterTilBogstav = Left(adr, p - 1)
        Exit Function
    Else
        konverterTilBogstav = ""
    End If
End Function
Private Function søgSidstePct(startCelle)
    Range(startCelle).Select
   
    While InStr(ActiveCell.Text, "%") = 0
        ActiveCell.Offset(-1, 0).Select
    Wend
   
    søgSidstePct = ActiveCell.Row
End Function

Tak for en super god løsning, omend det ikke helt er løsningen på min problemstilling.

Den csv fil man henter fra siden indeholder mere data end hvad siden umiddelbart byder en. Derfor er det ikke nok, at hente siden ned.

Jeg skal på en eller anden måde have fat i den underliggende csv fil (altså den der fremkommer ved tryk på download knappen).

Men mange tak for hjælpen.

Ok & selv tak

Lukker denne tråd - uden løsning