Gentage en web-forespørgsel med parametre via makro/VBA?

hvilken excel-version bruger du ??

Excel 2003

Jeg har oprettet 3 ark. "Numre" , "Query" og "Resultat"
Numrene står i "Numre" kolonne A
Forespørgslen i "Query" startede i A1
Resultatet leveres i "Resultat"
Vær opmærksom på ikke at overskrive de 65536 rækker :-)

Sub HentKirkeData()
Dim No As Variant
Dim rgIns As Range
Dim vNumre As Variant
  'Dette range skal du selv sætte
  vNumre = Sheets("Numre").Range("A2:A29")

  Application.ScreenUpdating = False

  For Each No In vNumre
      With Sheets("Query").Range("A1").QueryTable
        .Connection = _
        "URL;http://www.sogn.dk/radsted/index.php?mod=sognside&func=sogneInfo&p1=" & CStr(No)
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "10"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .Refresh BackgroundQuery:=False
      End With
      Sheets("Query").Range("A1:D17").Copy
      Set rgIns = Sheets("Resultat").Range("A65536").End(xlUp).Offset(4, 0)
      rgIns.PasteSpecial (xlPasteValues)
      rgIns.Font.Bold = True

  Next
  Application.ScreenUpdating = True
End Sub

Det ser lovende ud, men jeg har problemer.
Forstår jeg det rigtigt:
Jeg opretter tre regneark og giver dem dine navne.
I Numre indsættes numre fra A2 til A2170
Så opretter jeg en ny makro og indsætter din (rettede) tekst.

Skal jeg så ikke køre selve webforespørgslen, men blot din makro?
Hvis så - forstår jeg ikke helt det du skriver om at "Forespørgslen i "Query" startede i A1"

Hvis jeg blot kører makroen, får jeg fejl runtime error '1004'
application-defined or object-defined

du skal køre din web-forespørgsel 1 gang i "Query" A1 således at den ligger der. Min makro modificerer så web-forespørgslen x antal gange

Det virker rigtigt godt. Men ca. to tredjedele gennem listen stopper den med en fejl. Nu fik jeg selvfølgelig ikke skrevet teksten af, men noget med, at der ikke blev fundet numre eller noget i den stil. Jeg havde ikke mulighed for at trykke fortsæt, men kun end eller debug. Jeg testede lige det næste nummer i rækken, og der var tilsyneladende ingen problemer - siden fandtes. Kan jeg på nogen måde fortsætte indsamlingen, hvor det gik galt, eller skal jeg starte forfra?

Ja det kan du godt
Bare sæt reference til den celle under hvor den stoppede
fx. vNumre = Sheets("Numre").Range("A1025:A2000")
og kør igen

Mange tak (og point) for hjælpen.

Nu føler jeg mig som en komplet novice, hvad jeg også er, men hvordan pokker får jeg afleveret de point?

Jeg skal lige svare først :-)

Hvad kan du egentlig bruge det til, sådan som resultatet er opstillet nu. De må da være svært at lave statistik på dette materiale.

Hvis du vil omdanne det til en database så prøv at indsætte et ekstra ark og navngiv det "Data"

kør så denne kode

Type kirke
  Sogn As String
  Provsti As String
  Stift As String
  Myndighedskode As String
  Pastorat As String
  Kirker As Long
  Folkekirkemedlemmer As Long
  Kommune As String
  Kommunenr As String
  Amt As String
  Indbyggere As Long
  Fødte As Long
  Døde As Long
  Døbte As Long
  Vielser As Long
  Begravelser As Long
  Konfirmerede As Long
  Velsignelser As Long
End Type

Sub transfer2database()
Dim LastCell As Range
Dim c As Range, rIns As Range
Dim vkirke() As kirke
Dim Header
Dim temp As Long, i As Long, x As Long
  Header = Array("Sogn", "Provsti", "Stift", "Myndighedskode:", "Pastorat:", "Kirker i sognet/kirkedistriktet:", _
                  "Folkekirkemedlemmer:", "Kommune:", "Kommunenr:", "Amt:", "Indbyggere:", "Fødte:", "Døde:", "Døbte:", _
                  "Vielser:", "Kirkelige begravelser:", "Konfirmerede:", "Velsignelser:")

  Set LastCell = Sheets("resultat").Range("A65536").End(xlUp)
  temp = LastCell.Row / 18
  ReDim vkirke(temp)
  For Each c In Sheets("resultat").Range("A1", LastCell)
      If c.Font.Bold = True And UCase(c.Value) Like "*SOGN" Then
        With vkirke(i)
            .Sogn = c
            .Provsti = c.Offset(2, 0)
            .Stift = c.Offset(4, 0)
            .Myndighedskode = c.Offset(7, 1)
            .Pastorat = c.Offset(8, 1)
            .Kirker = c.Offset(9, 1)
            .Folkekirkemedlemmer = c.Offset(10, 1)
            .Kommune = c.Offset(7, 3)
            .Kommunenr = c.Offset(8, 3)
            .Amt = c.Offset(9, 3)
            .Indbyggere = c.Offset(10, 3)
            .Fødte = c.Offset(11, 1)
            .Døde = c.Offset(11, 3)
            .Døbte = c.Offset(13, 1)
            .Vielser = c.Offset(14, 1)
            .Begravelser = c.Offset(15, 1)
            .Konfirmerede = c.Offset(13, 3)
            .Velsignelser = c.Offset(14, 3)
        End With
        i = i + 1
      End If
  Next
  Sheets("Data").Range("A1:R1") = Header
  For x = 0 To UBound(vkirke)
      Set rIns = Sheets("Data").Range("A" & x + 2)
      With vkirke(x)
        rIns(1, 1) = .Sogn
        rIns(1, 2) = .Provsti
        rIns(1, 3) = .Stift
        rIns(1, 4) = .Myndighedskode
        rIns(1, 5) = .Pastorat
        rIns(1, 6) = .Kirker
        rIns(1, 7) = .Folkekirkemedlemmer
        rIns(1, 8) = .Kommune
        rIns(1, 9) = .Kommunenr
        rIns(1, 10) = .Amt
        rIns(1, 11) = .Indbyggere
        rIns(1, 12) = .Fødte
        rIns(1, 13) = .Døde
        rIns(1, 14) = .Døbte
        rIns(1, 15) = .Vielser
        rIns(1, 16) = .Begravelser
        rIns(1, 17) = .Konfirmerede
        rIns(1, 18) = .Velsignelser

      End With
  Next
End Sub

He - mange tak. Men at rense det til en database fra resultatet i den første model er et minimalt arbejde i Excel. Det klarer jeg ved hjælp af koder.
Dette er naturligvis mere elegant, men jeg var også på jagt i en model, der ved hjælp af minimale tilretninger kan bruges i andre, lignende sammenhænge.
Hvis jeg nu også skal lære lidt om VBA i denne omgang, kunne jeg så lokke dig til at "oversætte", hvad det er der sker i koden. Bare i den første model, du lavede. Der er et par dunkle punkter.

Sub HentKirkeData1()
Dim No As Variant
Dim rgIns As Range
Dim vNumre As Variant
  'Her hentes alle numre fra "Numre"-arket ind i et array i et hug
  vNumre = Sheets("Numre").Range("A2:A29")
  'skærmopdatering slås fra pga. hastighed
  Application.ScreenUpdating = False
  'for hvert nummer i nummer-arrayet
  For Each No In vNumre
      With Sheets("Query").Range("A1").QueryTable
        'ændring af connection-strengen til det nye nummer
        'CStr bruges til at lave nummeret til streng
        .Connection = _
        "URL;http://www.sogn.dk/radsted/index.php?mod=sognside&func=sogneInfo&p1=" & CStr(No)
        'Må IKKE fjernes . Angiver at vi kun henter en tabel og ikke en side
        .WebSelectionType = xlSpecifiedTables
        'kan fjernes
        .WebFormatting = xlWebFormattingNone
        'Tabel nummer 10 fra websiden. Dette er væsentlig
        .WebTables = "10"
        'kan fjernes
        .WebPreFormattedTextToColumns = True
        'kan fjernes
        .WebConsecutiveDelimitersAsOne = True
        'kan fjernes
        .WebSingleBlockTextImport = False
        'kan fjernes
        .WebDisableDateRecognition = False
        'Må IKKE fjernes, sørger for at web-queryen kører
        .Refresh BackgroundQuery:=False
      End With
      'kopier alt i query-området
      Sheets("Query").Range("A1:D17").Copy
      'på resultatarket findes nederste celle i kolonne A og  der lægges 4 rækker til
      Set rgIns = Sheets("Resultat").Range("A65536").End(xlUp).Offset(4, 0)
      'værdierne af det kopierede indsættes i resultatarket
      rgIns.PasteSpecial (xlPasteValues)
      'fed skrift på sogn
      rgIns.Font.Bold = True

  Next
  'slå skærmopdatering til igen. burde faktisk være unødvendigt
  Application.ScreenUpdating = True
End Sub