Private Sub add_products_Click()

    'Macro voor het geautomatiseerd toevoegen van producten aan acties op samenkopen.net
    'Made by Wouter (Wieltje). Vrij te gebruiken.
    'Bij tevreden gebruik graag naar eigen inzicht een extra donatie doen aan SK.net

    'Kopieer deze hele code naar de visual basic editor [ |extra|macro|visual basic editor
    'Macro runnen door ergens in de code te gaan staan en F5 te drukken
        
    'IE object moet toegevoegd zijn!
    '   [in vba editor: |Extra|Verwijzingen|"Microsoft Internet Controls" (c:\windows\system32\shdocvw.dll)
    
    'Definieer voor de bovenste cel van iedere kolom de naam die binnen Range("xxx").Column staat
    '   [in excel: cel selecteren en dan |invoegen|naam|definieren
    
actie_id = "772990"   'nummer van de actie (sk.net/action/xxxxxx)
rij_van = 10
rij_naar = 15       'tot én met rij_naar
    
   
    'Commentaar:
    'Zoals gezegd simpel, maar doeltreffend. Wellicht dat ik het ooit nog verfraai met een formuliertje met knoppen ed.
    
    'In de opzet van de sheet ben je geheel vrij. De juiste kolommen worden aangeduid door de bovenste cel
    '(de titel van de kolom dus) een naam te geven mbv |invoegen|naam|definieren. Hierdoor kun je later
    'altijd nog kolommen invoegen ed.
    
    'Er zitten geen controles in; zorg dus dat je geen lege namen of omschrijvingen hebt want die producten
    'worden simpelweg niet toegevoegd door het systeem van sk.
    
    'Omdat er geen gebruik wordt gemaakt van sendkeys of copy/paste oid is de PC verder gewoon te
    'gebruiken terwijl de macro draait. Het aantal producten dat nog toegevoegd moet worden wordt weergegeven
    'in de cel "Voortgang".
    
    '(De 'wait's van 1 sec zijn workarounds omdat het programma anders door onbekende oorzaak door wil gaan
    'terwijl de pagina nog niet volledig geladen is.)
'========================================================================================
    Dim IE As SHDocVw.InternetExplorer       'Declare Reference to IE Object
    Set IE = New SHDocVw.InternetExplorer    'Set Reference to IE Object
    IE.Visible = True   'niet uitzetten!
    
    Dim rij As Integer
    rij = rij_van
    Do While rij < rij_naar + 1
        Range("voortgang").Value = rij_naar + 1 - rij '
    
        IE.Navigate "http://samenkopen.net/myaction_productadd/" + actie_id
        
        'wacht tot pagina geladen is
        Application.Wait Now + TimeValue("0:00:01")
        Do While IE.ReadyState <> READYSTATE_COMPLETE
            DoEvents
        Loop
        Application.Wait Now + TimeValue("0:00:01")

        'formulier vullen
        With IE.Document.All
            .Item("group").Value = Cells(rij, Range("Productgroep").Column)
            .Item("sortnr").Value = Cells(rij, Range("Volgnummer").Column)
            .Item("title").Value = Cells(rij, Range("Productnaam").Column)
            .Item("shortdescription").Value = Cells(rij, Range("Korte_omschrijving").Column)
            .Item("price").Value = Cells(rij, Range("Verkoopprijs").Column)
            .Item("description").Value = Cells(rij, Range("Omschrijving").Column)
            .Item("shipunits").Value = Cells(rij, Range("Gewicht").Column)
            If Not (Cells(rij, Range("Beschikbaar").Column) = "") Then
                .Item("numberavailable").Value = Cells(rij, Range("Beschikbaar").Column)
            End If
            .Item("imageurl").Value = Cells(rij, Range("AfbeeldingURL").Column)
            '.Item("thumburl").Value = "URL thumbnail"
            
            '.Item("shipping").Value = "N" / "Y"
            '.Item("country").Value = "Netherlands" / "Belgium" / "All"
            
            
            'Alleen van toepassing bij uitgebreide BTWfactuur-functie
            '.Item("articlecode").Value=""
            '.Item("invoicedesc").Value = Cells(rij, Range("Productnaam").Column)
        End With
            
        'product toevoegen
        IE.Document.mainform.submit
        
        'wacht tot product toegevoegd is
        Application.Wait Now + TimeValue("0:00:01")
        Do While IE.ReadyState <> READYSTATE_COMPLETE
          DoEvents
        Loop
        Application.Wait Now + TimeValue("0:00:01")
        
        rij = rij + 1
    Loop

End Sub