Doel hyperlink opslaan in map via macro

[rickbakkenes]

Goedemorgen,

Ik heb onderstaande macro:

Sub MULTI_OPEN()
Dim kolom, rij As Integer
Dim adres As String

kolom = 2

For rij = 2 To 40
adres = Cells(rij, kolom).Value
ActiveWorkbook.FollowHyperlink Address:=adres, NewWindow:=True

Next rij

End Sub

Nu wil ik ipv dat de hyperlinks zich openen in een nieuw tabblad in Internet Explorer dat ze zich opslaan in een map bij "mijn documenten"

Als het er namelijk 15 zijn dan openen zich 15 schermpjes en dat is niet zo overzichtelijk.

Wie o wie kan mij helpen.

Alvast bedankt.

Groetjes,Rick

 

[Elsendoorn2134]

Rick,

Met onderstaande macro kun je bestanden kopiëren naar de zelfde directory als waarin het bronbestand staat.
Gegeven is wel dat alle hyperlinks op Blad1 staan.

Public Sub KopieerBestand()

Dim sHylink
Dim sBestand
Dim fs, f

Set fs = CreateObject("Scripting.FileSystemObject")

With ActiveWorkbook.Sheets("Blad1")
    For Each sHylink In .Hyperlinks
        sBestand = Mid(sHylink.Address, InStrRev(sHylink.Address, "/") + 1, 10000)
        Set f = fs.getfile(sHylink.Address)
        f.Copy ActiveWorkbook.Path & "\" & sBestand
    Next
End With

End Sub

Veel Succes.

 

[snb]

of

Public Sub M_snb()
     For Each hl In thisWorkbook.Sheets("Blad1").Hyperlinks
        filecopy  hl.address, thisworkbook.path & "\" & split(hl.address,"\")(ubound(split(hl.address,"\")))
     Next
End Sub

 

[rickbakkenes]

Hoi Elsendoorn 2134,

Kan ik ook pad aangeven waar ik ze neergezet wil hebben?

Op welke plek moet ik dit dan invullen in de macro?

Alvast bedankt.

Mvg Rick

 

[rickbakkenes]

Hoi SNB,

Naar welke map worden de afbeeldingen gekopieerd? Kan ik ook zelf een locatieopgeven? Bijvoorbeeld c:\betalingsrun

Mvg Rick

 

[snb]

Je kunt iedere lokatie opgeven die je wil.

 

[rickbakkenes]

waar moet ik dan exact neerzetten in de macro?

 

[Elsendoorn2134]

Rick,

Met Activeworkbook.path of Thisworkbook.path wordt het subdirectory opgehaald van het bestand waarin de
VBA code op dat moment actief is.
Vervang Activeworkbook.path of Thisworkbook.path gewoon door de door jou gekozen subdirectory.
dus

f.Copy ActiveWorkbook.Path & "\" & sBestand

wordt

f.Copy  "c:\betalingsrun\" & sBestand

Veel Succes.

 

[rickbakkenes]

De macro is als volgt.

De hyperlinks staan in kolom B (wel via vertikaalzoeken)

Public Sub KopieerBestand()

Dim sHylink
Dim sBestand
Dim fs, f

Set fs = CreateObject("Scripting.FileSystemObject")

With ActiveWorkbook.Sheets("MULTI-PRINTER")
For Each sHylink In .Hyperlinks
sBestand = Mid(sHylink.Address, InStrRev(sHylink.Address, "/") + 1, 10000)
Set f = fs.getfile(sHylink.Address)
f.Copy "c:\betalingsrun\" & sBestand
Next
End With

End Sub

Toch krijg ik een error bij het gele stuk.

De hyperlink is een plek naar onze server. (bijvoorbeeld)

http://nti-srv02:8590/orka/IFS/orka_invoice.aspx?titleid=OR45109.tiff

 

[Elsendoorn2134]

Rick,

En wat is de error die je krijgt?

Elsendoorn2134

 

[rickbakkenes]

Set f = fs.getfile(sHylink.Address)

 

[Elsendoorn2134]

Rick,

Dit is waar de fout plaats vind, maar wat voor error krijg je?
Kan het bestand niet worden gevonden, heb je geen toegang tot het bestand of mag je de bestanden
bij voorbeeld niet kopieren. Bij ieder foutmelding krijg je een nummer en een om schrijving, deze wil ik graag weten
om je te kunnen helpen.

Elsendoorn2134

 

[rickbakkenes]

Fout 53

Kan het bestand niet vinden

 

[Elsendoorn2134]

Rick,

Deze fout ontstaat als heb bestand niet kan worden gevonden op de opgegeven locatie.
Probeer het bestand eens op te zoeken met Explorer. Als je hem niet kan vinden bestaat
hij dus niet en is de fout terecht. Als je hem wel kan vinden probeer hem dan eens via
de explorer te openen. Het kan zijn dat je onvoldoende rechten hebt om het bestand direct
aan te spreken. Misschien dat je dan even moet gaan babbelen met de IT beheerder.

Veel Succes.

 

[snb]

Suggestie: begin eens bij het begin met een basisboek VBA.