Bildnamen automatisch einfügen und formatieren

[Moleman]

Hallo,

ich nutze Access 2003 und bin gerade dabei eine Bilderverwaltung zu erstellen.

Dabei soll es möglich sein, ein Bild direkt in die Datenbank zu ziehen, wodurch der Pfad als Hyperlink gespeichert wird. Dies klappt auch schon.

Jetzt möchte ich gerne, dass die Bezeichnung "Bild" sich den Pfadnamen automatisch bezieht, alle Unterordnerbezeichnungen löscht, so dass nur noch der Name des Bilder mit der Endung übrig bleibt.

Also soll nur die rechte Seiote des Pfades bis zum 1. Slash als Bildname bezogen werden.

Mit dem Steuerelementinhalt "=[Pfadname]" schreibt er den Pfadnamen in die Namensbezeichnung des Bildes, allerdings brauche ich jetzt Hilfe, wie er den Namen so formatiert, dass nur noch der Bildname samt Endung übrig bleibt.

z.B. Pfadname = C:/Windows/Bilder/hund.jpg
soll automatisch abgespeichert werden als Bildname: hund.jpg

VIelen Dank im Vorraus

 

[Drogist]

Moin,

schreib dir 'ne Function, die dir den gewünschten Wert zurück gibt. Die könnte so aussehen (Achtung, ungeprüft!)

Function cFilename(Pfadname as string) as string
   Dim Pos as Integer   
   Rc = ""
   If Len(Pfadname)>0 Then
      Pos=InStrRev(Pfadname)
   End If
   If Pos > 0 Then
      Rc=Right(Pfadname,Pos-1)
   End If
   cFilename=Rc
End Function

 

[Moleman]

Hi,

danke schon mal.

Ich habe mittlerweile auch schon einige passende Funktionen im Internet gefunden.

Aber wie binde ich die den ein in das Feld "Pfadname", so dass der Bildname automatisch reingeladen wird, nach dem der Pfad zum Bild eingefügt wurde.
Dass das über VBA funktioniert ist mir klar, aber der genaue Weg wäre sehr hilfreich :-(.

danke

 

[Moleman]

So hab mein Problem gelöst.

Folgender Code hat mir geholfen:

Private Sub txtPfadname_AfterUpdate()
'~=============================================================
Dim strText         As String
Dim sDrive          As String
Dim sPath           As String
Dim sFilename       As String
Dim sExtension      As String
Dim sSourcePath     As String
'--------------------------------------------------------------------------------------------------------------
On Error GoTo Err_txtPfadname_AfterUpdate
'--------------------------------------------------------------------------------------------------------------
strText = Me.txtPfadname                                            ' Text des OLE-Objektes in die Variable übertragen
strText = Replace(strText, "#", "")                                 ' Hash-Zeichen entfernen
    
sSourcePath = strText                                               ' Aufruf initialisieren
Call SplitPath(sSourcePath, sDrive, sPath, sFilename, sExtension)   ' Aufruf zum Pfad splitten

Me.txtName = sFilename & "." & sExtension

Exit_txtPfadname_AfterUpdate:
    Exit Sub

Err_txtPfadname_AfterUpdate:
    MsgBox "Fehler in txtPfadname_AfterUpdate(), " & vbCrLf & _
           Err.Number & " - " & Err.Description
    Resume Exit_txtPfadname_AfterUpdate

End Sub

Dies sorgt dann Quasi dafür, dass der Pfad des hereingeschobenen Bildes zerlegt wird und der Dateiname + Extension als Bildname gespeichert wird.

Danke für eure Hilfe!

 

[vfl_freak]

zum Thema selbst kann ich nicht viel sagen, aber ich dachte, dass mein Profilbild hier nett hinpassen würden

Gruß
Klaus

 

[Drogist]

Moin Moleman,

schön dass du deine Lösung hier aufzeigst, Beim Code allerdings fehlt der entscheidende Teil, nämlich die Funktion SplitFile(), welche du ja aufrufst, um den Pfadnamen in seine Einzelteile zu zerlegen. Die solltest du auch posten ...

 

[Moleman]

Huhu,

oh natürlich

Hier:

Option Compare Database
Option Explicit
Sub SplitPath(ByVal sSourcePath As String, ByRef sDrive As String, _
              ByRef sPath As String, ByRef sFilename As String, _
              ByRef sExtension As String)
 
Dim iOffset As Integer

iOffset = InStr(sSourcePath, "\")

If iOffset = 0 Then Exit Sub
    sDrive = Left(sSourcePath, iOffset - 1)
    sPath = Mid(sSourcePath, iOffset + 1)
    For iOffset = Len(sPath) To 1 Step -1
        If Mid(sPath, iOffset, 1) = "\" Then
            sFilename = Mid(sPath, iOffset + 1)
            sPath = Left(sPath, iOffset - 1)
            Exit For
        End If
    Next
    
    If Len(sFilename) > 0 Then
    For iOffset = Len(sFilename) To 1 Step -1
        If Mid(sFilename, iOffset, 1) = "." Then
            sExtension = Mid(sFilename, iOffset + 1)
            sFilename = Left(sFilename, iOffset - 1)
            Exit For
        End If
    Next
    End If
 
End Sub

Viel Spaß damit!

@vfl_freak: ich finde dein Logo nicht passend, da die beiden Vereine nicht auf gleicher Augenhöhe agieren ;-)