Dateien Anzeigen, Umbenennen, senden
12.07.2022 21:32:16
DasFragezeichen
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
Danke & Gruß, DasFragezeichen
Anzeige