Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 08:41:23
Zwei Makros in ein Arbeitsblatt - zweite wird nicht ausführt
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1740to1744
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1740to1744
1740to1744
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bilder über URL herunterladen

Bilder über URL herunterladen
15.02.2020 20:29:05
Kisska
Hallo allerseits,
ich habe einen Code gefunden, mit dem ich über URLs Bilder herunterlade: 

Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Dim Ret As Long
'~~> This is where the images will be saved. Change as applicable
Const FolderName As String = "D:\Ordner1\Ordner2\Ordner3\Ordner4\Ordner5
Sub DownloadLinks()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim strPath As String
'~~> Name of the sheet which has the list
Set ws = ActiveSheet
LastRow = ws.Range("AU" & Rows.Count).End(xlUp).Row 'AU: Spalte mit Datei-Namen
For i = 2 To LastRow '

(Quelle: https://stackoverflow.com/questions/23742636/download-pictures-from-url-and-save-in-a-folder-named-by-a-cell/23742732)
Der Code funktioniert nicht einwandfrei.
Die Bilder werden zwar heruntergeladen, aber sie landen nicht wie im Pfad angegeben, im Ordner5, sondern im Ordner4. Die Dateinamen werden mit dem Namen "Ordner5" vorne ergänzt. Wenn ich "FolderName " im Code " strPath = FolderName & " weglasse, dann werden komischerweise gar keine Bilder heruntergeladen.
Kann jemand helfen?
VG, Kisska

21
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bilder über URL herunterladen
15.02.2020 20:38:05
Werner
Hallo,
schätze mal dir fehlt der Backslash nach deinem FolderName. 
strPath = FolderName & "/" & ws.Range("AU" & i).Value
Gruß Werner
danke! & Zusatzfrage
15.02.2020 21:12:12
Kisska
Hallo Werner,
besten Dank, jetzt klappt alles!
Könntest mir zusätzlich helfen, den Code um diese zwei Funktionen zu erweitern:
a) Wenn das Bild mit dem Namen wie in der Spalte AU bereits heruntergeladen ist, dann soll nicht nochmal heruntergeladen werden und in der Spalte AS soll "already downloaded" ausgegeben werden.
b) Bilder sollen nicht von allen URLS aus der Spalte AR heruntergeladen werden, sondern nur von den markierten
VG, Kisska
Anzeige
Rückfrage
Werner
Hallo,
und wie und wo sind die markiert?
Gruß Werner
AW: danke! & Zusatzfrage
Werner
Hallo,
wie und wo sind die markiert?
Gruß Werner
AW: danke! & Zusatzfrage
Werner
Hallo,
wie und wo sind denn die markiert?
Gruß Werner
AW: danke! & Zusatzfrage
Werner
Hallo,
wie und wo sind die denn markiert?
Gruß Werner
ich versuchs nochmal
16.02.2020 13:25:57
Werner
Hallo,
wo und wie sind die markiert?
Gruß Werner
AW: ich versuchs nochmal
16.02.2020 14:11:35
Kisska
Hallo Wermer,
bspw. werden die Zellen mit den URLs im Bereich AR2:AR10 ausgewählt, beim nächsten Mal im Bereich AR30:AR40.
VG, Kisska
AW: ich versuchs nochmal
16.02.2020 18:07:34
Werner
Hallo,
teste mal: 
Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub DownloadLinks()
Dim raZelle As Range, Ret As Long, strPath As String
Const FolderName As String = "D:\Ordner1\Ordner2\Ordner3\Ordner4\Ordner5"
Application.ScreenUpdating = False
For Each raZelle In Range(Cells(Selection.Cells(1, 1).Row, "AU"), _
Cells(Selection.Rows.Count + 1, "AU"))
If WorksheetFunction.CountIfs(Columns("AU"), raZelle.Value, Columns("AS"), _
"File successfully downloaded") = 0 Then
strPath = FolderName & "/" & raZelle.Value
Ret = URLDownloadToFile(0, raZelle.Value, strPath, 0, 0)
If Ret = 0 Then
raZelle.Offset(, -2).Value = "File successfully downloaded"
Else
raZelle.Offset(, -2).Value = "Unable to download the file"
End If
Else
If raZelle.Offset(, -2)  "File successfully downloaded" Then
raZelle.Offset(, -2) = "already downloaded"
End If
End If
Next raZelle
End Sub
Gruß Werner
Anzeige
AW: ich versuchs nochmal
17.02.2020 15:10:35
Kisska
Hallo Werner,
ich bekomme leider immer "Unable to download the file".
Kann es sein, dass die Spalten im Code anders definiert sind?
Hier meine Spalten:
- Spalte mit URLs: AR
- Spalte mit dem Download-Status: AS
- Spalte mit Datei-Namen: AU
Ich habe eine einfachere Tabelle als Versuch gebaut mit :
'Spalte mit URLs: C
'Spalte mit Datei-Namen: D
'Spalte mit dem Download-Status: E
Das Ersetzen von AU durch D und AS durch E in deinem Code überschreibt dann die Daten in der Spalte B. Die Daten in den Spalten A und B brauche ich aber, um die URLS in der Spalte C zu erzeugen. Ich blicke nicht durch, was ich im Code anpassen muss, damit die richtigen Spalten angesprochen werden.
Kannst du helfen? Eine feste Spaltenangabe als Buchstabe wäre hilfreich.
VG, Kisska
Anzeige
AW: ich versuchs nochmal
17.02.2020 16:01:41
Werner
Hallo,
bin da wohl mit den Spalten durcheinander gekommen.
Versuch mal so: 
Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub DownloadLinks()
Dim raZelle As Range, Ret As Long, strPath As String
Const FolderName As String = "D:\Ordner1\Ordner2\Ordner3\Ordner4\Ordner5"
Application.ScreenUpdating = False
For Each raZelle In Range(Cells(Selection.Cells(1, 1).Row, "AU"), _
Cells(Selection.Rows.Count + 1, "AU"))
If WorksheetFunction.CountIfs(Columns("AU"), raZelle.Value, Columns("AS"), _
"File successfully downloaded") = 0 Then
strPath = FolderName & "/" & raZelle.Value
Ret = URLDownloadToFile(0, Cells(raZelle.Row, "AR").Value, strPath, 0, 0)
If Ret = 0 Then
Cells(raZelle.Row, "AS").Value = "File successfully downloaded"
Else
Cells(raZelle.Row, "AS").Value = "Unable to download the file"
End If
Else
If Cells(raZelle.Row, "AS").Value  "File successfully downloaded" Then
Cells(raZelle.Row, "AS").Value = "already downloaded"
End If
End If
Next raZelle
End Sub
Gruß Werner
Anzeige
nun klappt es
17.02.2020 16:48:57
Kisska
Hallo Werner,
jetzt funktioniert der Code wie gewünscht, bin begeistert. Herzlichen Dank!
Eine Kleinigkeit noch: Wenn der FolderName nicht existiert, dann wird trotzdem "File successfully downloaded" ausgegeben. Wie kann man das verhindern bzw. kann ein Hinweis erscheinen, dass ein korrekter Speicherort anzugeben ist?
VG, Kisska
doch nicht fehlerfrei
17.02.2020 16:59:32
Kisska
Hallo Werner,
bei meinem zweiten Test ist mir aufgefallen, dass das Makro dann fehlerfrei läuft, wenn man bspw. die Zeilen 1 bis 15 markiert, dann werden alle Bilder korrekt heruntergeladen.
Markiert man dagegen bspw. die Zeilen 9 bis 15, dann werden nur die Bilder aus den Zeilen 8 und 9 heruntergeladen (obwohl 8 nicht mal markiert war).
VG, Kisska
Anzeige
AW: doch nicht fehlerfrei
18.02.2020 08:56:40
Werner
Hallo,
dann mal so. Die Auswahl mußt duin Spalte AU treffen. 
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub DownloadLinks()
Dim raZelle As Range, Ret As Long, strPath As String
Const FolderName As String = "D:\Ordner1\Ordner2\Ordner3\Ordner4\Ordner5"
Application.ScreenUpdating = False
If Selection.Column  47 Then
MsgBox "Fehler: Bereichsauswahl bitte in Spalte AU"
Exit Sub
End If
For Each raZelle In Selection
If WorksheetFunction.CountIfs(Columns("AU"), raZelle.Value, Columns("AS"), _
"File successfully downloaded") = 0 Then
strPath = FolderName & "\" & raZelle.Value
Ret = URLDownloadToFile(0, Cells(raZelle.Row, "AR").Value, strPath, 0, 0)
If Ret = 0 Then
Cells(raZelle.Row, "AS").Value = "File successfully downloaded"
Else
Cells(raZelle.Row, "AS").Value = "Unable to download the file"
End If
Else
If Cells(raZelle.Row, "AS").Value  "File successfully downloaded" Then
Cells(raZelle.Row, "AS").Value = "already downloaded"
End If
End If
Next raZelle
End Sub
Gruß Werner
Anzeige
klappt!
19.02.2020 23:49:38
Kisska
Hallo Werner,
nun klappt der Download der Auswahl wie gewünscht. Dankeschön :-)
Wenn ich noch die Meldung bekommen könnte, wenn der FolderName nicht existiert, wäre ich restlos glücklich.
Ich habe Folgendes vor der Zeile mit "If Ret = 0 Then" eingefügt: 

If FolderName  "" Then
MsgBox "Fehler: Ordner '" & FolderName & "' konnte nicht gefunden werden"
Exit Sub
Else

Das funktioniert aber nicht, ich weiß nicht wohin ich End If setzen soll.
VG, Kisska
AW: klappt!
20.02.2020 00:17:05
Werner
Hallo,
wozu denn eine Messagebox?
Mit dem Code wird geprüft, ob das Verzeichnis wie bei Const FolderName angegeben existiert. Wenn nein, dann wird es entsprechend angelegt. 
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Sub DownloadLinks()
Dim raZelle As Range, Ret As Long, strPath As String
Const FolderName As String = "D:\Ordner1\Ordner2\Ordner3\Ordner4\Ordner5\"
'Prüfung ob Verzeicnis FolderName von oben existiert
'wenn nicht, wird es angelegt (von Rudi Maintaire hier aus dem Forum)
MakeSureDirectoryPathExists FolderName
Application.ScreenUpdating = False
If Selection.Column  47 Then
MsgBox "Fehler: Bereichsauswahl bitte in Spalte AU"
Exit Sub
End If
For Each raZelle In Selection
If WorksheetFunction.CountIfs(Columns("AU"), raZelle.Value, Columns("AS"), _
"File successfully downloaded") = 0 Then
strPath = FolderName & raZelle.Value
Ret = URLDownloadToFile(0, Cells(raZelle.Row, "AR").Value, strPath, 0, 0)
If Ret = 0 Then
Cells(raZelle.Row, "AS").Value = "File successfully downloaded"
Else
Cells(raZelle.Row, "AS").Value = "Unable to download the file"
End If
Else
If Cells(raZelle.Row, "AS").Value  "File successfully downloaded" Then
Cells(raZelle.Row, "AS").Value = "already downloaded"
End If
End If
Next raZelle
End Sub
Gruß Werner
Anzeige
AW: klappt!
20.02.2020 01:22:43
Kisska
Hallo Werner,
danke, das ist zwar eine wissenswerte Lösung, aber ich wollte tatsächlich vermeiden, dass wenn das Verzeichnis nicht existiert, man keinen Text "File successfully downloaded" in der Spalte "AS" angezeigt bekommet. Ohne eine zusätzliche Messagebox könnte man denken, dass das Makro nicht läuft, daher ist ein Hinweis hilfreich.
VG, Kisska
AW: klappt!
20.02.2020 13:04:10
Werner
Hallo,
so? 
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub DownloadLinks()
Dim raZelle As Range, Ret As Long, strPath As String
Dim Fso As Object
Const FolderName As String = "D:\Ordner1\Ordner2\Ordner3\Ordner4\Ordner5\"
Set Fso = CreateObject("Scripting.FileSystemObject")
If Not Fso.FolderExists(FolderName) Then
MsgBox "Das Verzeichnis " & vbLf & vbLf _
& FolderName & vbLf & vbLf & " existiert nicht."
Exit Sub
End If
Application.ScreenUpdating = False
If Selection.Column  47 Then
MsgBox "Fehler: Bereichsauswahl bitte in Spalte AU"
Exit Sub
End If
For Each raZelle In Selection
If WorksheetFunction.CountIfs(Columns("AU"), raZelle.Value, Columns("AS"), _
"File successfully downloaded") = 0 Then
strPath = FolderName & raZelle.Value
Ret = URLDownloadToFile(0, Cells(raZelle.Row, "AR").Value, strPath, 0, 0)
If Ret = 0 Then
Cells(raZelle.Row, "AS").Value = "File successfully downloaded"
Else
Cells(raZelle.Row, "AS").Value = "Unable to download the file"
End If
Else
If Cells(raZelle.Row, "AS").Value  "File successfully downloaded" Then
Cells(raZelle.Row, "AS").Value = "already downloaded"
End If
End If
Next raZelle
Set Fso = Nothing
End Sub
Gruß Werner
Anzeige
super! ... letzte Fragen
21.02.2020 17:32:39
Kisska
Hallo Werner,
ja genau so! Danke vielmals!
Erlaube mir zwei abschließende Fragen:
1. Ich habe ein Szenario entdeckt, bei dem der Code nicht ganz funktioniert:
Beispiel:
AU 2 bis 5 werden markiert, wobei URLs nur in AR2, AR3 und AR5 stehen. In AR4 steht ein #NV.
Das Makro führt zum Laufzeitfehler 13 "Typen unverträglich" (nach Debuggen gelange ich zu 

strPath = FolderName & "\" & raZelle.Value
), aber es werden trotzdem die Bilder zu AR2 und AR3 heruntergeladen, nicht aber zu AR5.
Kann man das verbessern?
2. Wenn das Bild zu der angegebenen URL im I-net nicht existiert, dann wird ein leeres Bild heruntergeladen (43 Bytes).
Ist es irgendwie möglich, dass in so einem Fall gar kein Bild heruntergeladen wird? Es sollen nur die Bilder heruntergeladen werden, die tatsächlich im I-net existieren.
VG, Kisska
Anzeige
und hier...
17.02.2020 16:12:19
Werner
Hallo,
strPath = FolderName & "/" & raZelle.Value

ist auch der Slash und nicht der Backslash drin. Ändern in: 
strPath = FolderName & "\" & raZelle.Value
Gruß Werner
AW: Bilder über URL herunterladen
Werner
Hallo,
ein Versuch über den Eingangsbeitrag.
Wie und wo sind die markiert?
Gruß Werner

Links zu Excel-Dialogen

MessageBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige