Dansk Regneark Forum
  Hjælp Hjælp  Søg i forum   Arrangementer   Opret ny bruger Opret ny bruger  Log ind Log ind


Emne lukketExport af Query data til Excel
 Besvar Besvar
Forfatter
  Emne Søg Emne Søg  Emne funktioner Emne funktioner
Ronni89 Se dropdown
Forum Begynder
Forum Begynder


Medlem: 10.Sep.2012
Status: Offline
Point: 8 		Direkte link til dette indlæg Emne: Export af Query data til Excel
    Sendt: 15.Sep.2012 kl. 12:54
Hej Alle.

Jeg skal hente en data tabel fra en webside med login og password. 
Jeg kommer forbi denne side og næste side er:
Det er dog ikke på denne side jeg skal hente tabellen, og muligvis derfor får jeg fejlmeddelelsen Run-time error 1004, application-defined ot object-defines error. Jeg skal klikke på "et link" her for at navigere til:
som er siden jeg skal hente tabellen fra. 

Kan nogle hjælpe mig med at navigere videre på siden, eller se hvad der ellers er galt? det er som om jeg mangler at kunne sætte et step ind.

Sub Basic_Web_Query()

Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = True
        .navigate "http://www.installationsblanket.dk/logon.asp"
        Do Until .readyState = READYSTATE_COMPLETE
                    DoEvents
        Loop
        .document.all.Item("BRUGERNAVN").Value = "Bruger"
        .document.all.Item("ADGANGSKODE").Value = "Adgangskode"
        .document.forms(0).submit
    End With
    
                    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.installationsblanket.dk/selskab/600-main.asp", Destination:= _
        Range("$A$1"))
        .Name = "600-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

Bruger og adgangskode er sløret.
På forhånd tak.
Til top



Til top
Ronni89 Se dropdown
Forum Begynder
Forum Begynder


Medlem: 10.Sep.2012
Status: Offline
Point: 8 		Direkte link til dette indlæg Sendt: 15.Sep.2012 kl. 17:29
Jeg har dog et problem, da der ingen Tabel ID er på denne side. Kan jeg sætte hele siden ind på nogen måde?

Sub GetTable()
   
    Dim ieApp As InternetExplorer
    Dim ieDoc As Object
    Dim ieTable As Object
    Dim clip As DataObject
   
    'create a new instance of ie
   Set ieApp = New InternetExplorer
   
    'you don’t need this, but it’s good for debugging
   ieApp.Visible = True
   
    'assume we’re not logged in and just go directly to the login page
   ieApp.navigate "http://www.installationsblanket.dk/Logon.asp"
    Do While ieApp.Busy: DoEvents: Loop
    Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
           
    Set ieDoc = ieApp.document
   
    'fill in the login form – View Source from your browser to get the control names
   With ieDoc.forms(0)
        .Brugernavn.Value = "***"
        .Adgangskode.Value = "***"
        .submit
    End With
    Do While ieApp.Busy: DoEvents: Loop
    Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
   
    'now that we’re in, go to the page we want
   ieApp.navigate "http://www.installationsblanket.dk/selskab/600.asp"
    Do While ieApp.Busy: DoEvents: Loop
    Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
   
    'get the table based on the table’s id
   Set ieDoc = ieApp.document
    Set ieTable = ieDoc.all.Item("Bottom")
   
    'copy the tables html to the clipboard and paste to teh sheet
   If Not ieTable Is Nothing Then
        Set clip = New DataObject
        clip.SetText "<html>" & MieTable.outerHTML & "</html>"
        clip.PutInClipboard
        Sheet1.Select
        Sheet1.Range("A1").Select
        Sheet1.PasteSpecial "Unicode Text"
    End If
   
    'close 'er up
   ieApp.Quit
    Set ieApp = Nothing
   
End Sub
Til top
 Besvar Besvar

Skift forum Forum tilladelser Se dropdown

© 2010 - 2024 Dansk Regneark Forum - en del af Excel-regneark.dk