Dateien Anzeigen, Umbenennen, senden
11.08.2022 13:20:46
Das
habe ein Thema, was ich lösen muss. Ich möchte Fotos aus einem definierten Ordner versenden, welche zuvor den Namen des Ordners als Suffix erhalten (KWXX_Inspection_IMGXXXX). Alle Dateien/Fotos sollen einzeln per Email mit der Benennung im Betreff an eine Emailadresse gesendet werden.
Zur Umbenennung habe ich folgendes Video auf Youtube gefunden: https://www.youtube.com/watch?v=wTPSqjOJfVE und den Code übertragen:
Private Sub commandbutton3_click()
Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Dim last_row As Integer
last_row = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xup).Row
Set fo = fso.getfolder(Worksheet("sheet1").Cells(2, 5).Value)
For Each f In fo.Files
last_row = last_row + 1
Worksheets("Sheet1").Cells(last_row, 1).Value = f.Name
Next
Worksheets("Sheet1").Cells(1, 1).Select
MsgBox ("List of file names is created")
End Sub
Private Sub Schaltfläche4_Klicken()
Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Dim last_row As Integer
last_row = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xup).Row
Set fo = fso.getfolder(Worksheet("sheet1").Cells(2, 5).Value)
Dim new_name As String
For Each f In fo.Files
For i = 2 To last_row
new_name = Worksheet("sheet1").Cells(i, 2).Value
f.Name = new_name
End If
Next
Next
MsgBox ("Done")
End Sub
Hatte diese Frage vor Wochen bereits einmal hier im Forum, wurde aber mittlerweile geschlossen. Keine der Antworten hatte geholfen. Hoffe wir kriegen es diesmal hin.
Danke & Gruß, DasFragezeichen