VBA jpg-Export von mehreren Links

Hallo liebe Herber-Community,
ich habe mal wieder eine kleine VBA Herausforderung zu lösen und benötige eure Hilfe.
Ich habe eine Liste mit 5 Spalten A bis E. Ca. 180 Datensätze, je einer pro Zeile versteht sich. Spalte A enthält eine Identnummer die ich mit Hilfe der Funktion =Verketten($A1&".BILD1.jpg") bzw. =Verketten($A1&".BILD2.jpg") in den Spalten B bzw. D als gewünschten Dateinamen ausgeben lasse. Die darauffolgenden Spalten C und E enthalten den Link ..\..\..\..\Desktop\Bilder\Picture1.jpg (machmal auch .bmp oder .tiff).
_|___A__|_______B______|__C__|_______D______|__E__|
1|Nummer|=VERKETTEN(....) | Link 1|=VERKETTEN(....) | Link 2|
2|
..
180|
Soweit der Aufbau der Tabelle.
Ziel ist es nun, alle 360 Bilder (je zwei pro Datensatz) unter dem gewünschten Dateinamen (B und D) in einem Ordner abzuspeichern. Der jeweilige Link verweist auf die Datei die abgespeichert werden soll (C und E). Der gewünschte Speicherort ist ein Desktopordner. Ist dies überhaupt per VBA möglich? Kann VBA mit den unterschiedlichen Dateiformaten umgehen? Ich hab bereits gesehen, dass man MSPAint per VBA "fernsteuern" kann. Geht das auch mit mehreren Dateien innerhlab einer Schleife?
Danke für eure Hilfe. Beste Grüße...
Hendrik

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Moin! Hier mal eine Variante die eigentlich gehen sollte. So wie ich das sehe, möchtest du nur die Bilder umgespeichert haben und nicht bearbeitet. Von daher sollten auch mehrer Dateiformate gehen, da mit den Dateien nichts weiter angestellt. Sie werden aber durch den Code nicht verschoben (wäre auch möglich), sondern nur an dem gewünschten Ort nochmal gespeichert. Einfach mal testen. VG


Sub bilder_umspeichern()
Dim ende As Long    'für Anzahl der Zeilen
Dim zeile As Long
Dim spalte As Long
Dim speicherort As String
Dim blatt As Object
Dim name As String
Dim pfad As String
'hier das Blatt ggf. nochmal festlegen
Set blatt = Worksheets(3)
'prüfen wieviele NUmmern eingetragen wurden
ende = blatt.Cells(Rows.Count, 1).End(xlUp).Row
'Speichert auswählen, alternativ auch gleich fest vorgeben
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
If .Show = -1 Then
speicherort = .SelectedItems(1) & "\"
Else
MsgBox "Kein Ordner gewählt - Ende!", , "Fehlender Ordner"
End
End If
End With
'start ist in Zeile 2, da in 1 vermtl. Überschrift
For zeile = 2 To ende
For spalte = 3 To 5 Step 2
pfad = CStr(blatt.Cells(zeile, spalte))
name = CStr(blatt.Cells(zeile, spalte - 1))
'beide Bilder auswählen und wenn vorhanden, verschieben
If Dir(pfad)  "" And name  "" And pfad  "" Then
FileCopy pfad, speicherort & name
End If
Next spalte
Next zeile
Set blatt = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

VBA jpg-Export von mehreren Links

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread