Bildauswahl - Bild kopieren

[Andyle]

Hallo an alle!

Ich habe folgende Vorstellung, komme allerdings nicht weiter.

In einem Schadenprotokoll kann man 3 Bilder einfügen.

Diese können irgendwo auf dem PC gespeichert sein.

Um aber nun die Verfügbarkeit der Bilder zu gewährleisten möchte ich folgendes ändern.

Bild auf PC wählen

Code:

Private Sub Bild1_Durchsuchen_Click()
Dim fileToOpen As String
fileToOpen = Application.GetOpenFilename("Bild 1 (*.jpg;*bmp;*gif;*png;*tif),*.jpg,*bmp,*gif,*png,*tif")
txt_Bild1 = fileToOpen
End Sub

gewähltes Bild soll beim Speichern im UserForm in einen Hauptordner kopiert werden und der Pfad soll sich automatisch zum Hauptordner ändern und in die Tabelle speichern.


Bsp.
Auswahl:                 C:\Bilder\Testbild_1.jpg
Textbox1:                C:\Bilder\Testbild_1.jpg
Kopieren nach:         D:\Schadenbilder\SN_Bild_1.jpg
D:\Schadenbilder\SN_Bild_1.jpg   muss dann in die Tabelle gespeichert werden.

Vielen Dank für Eure Hilfe

[Andyle]

Die Lösung!

  Dim dateiname As String
  Dim dateiendung As String
  Dim punktPosition As Integer

  dateiname = txt_Bild1 ' Beispiel Dateiname

  ' Finde die Position des letzten Punktes
  punktPosition = InStrRev(dateiname, ".")

  ' Wenn ein Punkt gefunden wurde, extrahiere die Dateiendung
  If punktPosition > 0 Then
    dateiendung = Right(dateiname, Len(dateiname) - punktPosition)
    MsgBox dateiendung ' Ausgabe im Direktfenster
  End If

    FileCopy txt_Bild1, ThisWorkbook.Path & "\Schadenbilder\" & "SM_" & txt_schadennummer & "_Bild_1." & dateiendung
   
    txt_Bild1 = ThisWorkbook.Path & "\Schadenbilder\" & "SM_" & txt_schadennummer & "_Bild_1." & dateiendung

[winner13]

Hallo,

wenn die Dateiendung immer dabei ist, kannst Du auch einfach das nehmen:

dateiendung=replace(right(dateiname,4),".","")

Das würde 3- und 4-stellige Endungen berücksichtigen. Rechts hast Du entweder die 4 Zeichen oder 3 Zeichen und davor den Punkt. Den entfernt replace...

[snb]

Code:

  MsgBox CreateObject("scripting.filesystemobject").getextensionname("G:\OF\beispeil.docm")