MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access - MOF-FAQ > MOF-FAQ - Module/VBA/VBE
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 11.01.2003, 12:08   #1
Stefan Kulpa
MS-Office-Forum Team MS-Office-Forum Team
Tipp Wie kann man einen Dateipfad zerlegen?

Oft steht man vor dem Problem, einen kompletten Dateipfad vorliegen zu haben, aus dem man allerdings nur einen Teil benötigt. Generell setzt sich ein Dateipfad aus vier Teilen zusammen:

1. Laufwerksbuchstabe
2. Verzeichnispfad
3. Dateiname
4. Dateierweiterung

Um nun diesen Pfad in seine Einzelteile zerlegen zu können, kann man auf verschiedene Art und Weise vorgeben:

Lösung 1: Nutzung des Windows Scripting Host
Um den Windows Scripting Host benutzen zu können, muss man entweder einen Verweis auf die entsprechende DLL-Datei (SCRRUN.DLL im System-Verzeichnis) setzen, oder aber mit LateBinding (sprich: CreateObject) arbeiten.

Code:

Sub SplitPath(ByVal sSourcePath As String, ByRef sDrive As String, _
              ByRef sPath As String, ByRef sFilename As String, _
              ByRef sExtension As String)
'// ------------------------------------------------------------------------
'// Die Variablen sDrive, sPath, sFilename und sExtension müssen ByRef
'// übergeben werden (was standardmäßig der Fall ist, und hier nur
'// exemplarisch dargestellt ist), damit diese als Rückgabewerte fungieren
'// können. ByVal übergibt eine Kopie und ist somit nicht für die Rückgabe
'// geeignet.
'// ------------------------------------------------------------------------
'// Variante 1 MIT Verweis auf die Microsoft Scripting Runtime.
'// Hier ist ein Verweis auf die SCRRUN.DLL im System-Verzeichnis notwendig.
'// ------------------------------------------------------------------------
    Dim objFso As New FileSystemObject
'// ------------------------------------------------------------------------
'// ODER Variante 2 OHNE Verweis auf Microsoft Scripting Runtime
'// ------------------------------------------------------------------------
    Dim objFso As Object
    Set objFso = CreateObject("Scripting.FileSystemObject")
'// ------------------------------------------------------------------------
    sDrive = objFso.GetDriveName(sSourcePath)
    sPath = objFso.GetParentFolderName(sSourcePath)
    sFilename = objFso.GetBaseName(sSourcePath)
    sExtension = objFso.GetExtensionName(sSourcePath)
 
End Sub
 
Sub Beispiel()
 
    Dim sDrive      As String
    Dim sPath       As String
    Dim sFilename   As String
    Dim sExtension  As String
    Dim sSourcePath As String
 
    sSourcePath = "C:\Programme\Microsoft Office\Office10\WINWORD.EXE"
    Call SplitPath(sSourcePath, sDrive, sPath, sFilename, sExtension)
'// Ausgabe ----------------------------------------------------------------
    Debug.Print "Originalpfad: "; sSourcePath
    Debug.Print "Laufwerk: "; sDrive
    Debug.Print "Pfad: "; sPath
    Debug.Print "Dateiname: "; sFilename
    Debug.Print "Dateierweiterung: "; sExtension
'// ------------------------------------------------------------------------
'// Originalpfad: C:\Programme\Microsoft Office\Office10\WINWORD.EXE
'// Laufwerk: C:
'// Pfad: C:\Programme\Microsoft Office\Office10
'// Dateiname: WINWORD
'// Dateierweiterung: EXE
'// ------------------------------------------------------------------------
End Sub
Code eingefügt mit dem MOF Code Converter

Hinweis: man muss sich für eine Variante entscheiden und den entsprechenden Teil im Beispiel deaktivieren oder löschen.

Lösung 2: String-Manipulation mit VBA-Hausmitteln

Unter Berücksichtigung von VBA-Version < 6 wird auf die neue Funktion InStrRev() aus VBA 6.0 in folgendem Beispiel verzichtet:

Code:

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
'// ------------------------------------------------------------------------
'// Zunächst den ersten Backslash suchen
'// ------------------------------------------------------------------------
    iOffset = InStr(sSourcePath, "\")
    If iOffset = 0 Then Exit Sub 'da ungültiger Dateipfad
'// ------------------------------------------------------------------------
'// Laufwerksbuchstaben ohne Backslash merken
'// ------------------------------------------------------------------------
    sDrive = Left(sSourcePath, iOffset - 1)
'// ------------------------------------------------------------------------
'// Jetzt den Ordner ermitteln
'// ------------------------------------------------------------------------
    sPath = Mid(sSourcePath, iOffset + 1)
'// ------------------------------------------------------------------------
'// In String für den Ordner befindet sich jetzt noch der Dateiname,
'// also den String bis zum letzten Backslash rückwärts durchsuchen
'// ------------------------------------------------------------------------
    For iOffset = Len(sPath) To 1 Step -1
        If Mid(sPath, iOffset, 1) = "\" Then
        '// Letzten Backslash gefunden
            sFilename = Mid(sPath, iOffset + 1)
            sPath = Left(sPath, iOffset - 1)
            Exit For
        End If
    Next
'// ------------------------------------------------------------------------
'// Dateiendung ermitteln; da es mehrere Punkte in einem Dateinamen
'// geben darf, zählt hier nur der letzte.
'// ------------------------------------------------------------------------
    If Len(sFilename) > 0 Then
    For iOffset = Len(sFilename) To 1 Step -1
        If Mid(sFilename, iOffset, 1) = "." Then
        '// Letzten Punkt gefunden
            sExtension = Mid(sFilename, iOffset + 1)
            sFilename = Left(sFilename, iOffset - 1)
            Exit For
        End If
    Next
    End If
 
End Sub
 
Sub Beispiel()
 
    Dim sDrive      As String
    Dim sPath       As String
    Dim sFilename   As String
    Dim sExtension  As String
    Dim sSourcePath As String
 
    sSourcePath = "C:\Programme\Microsoft Office\Office10\WINWORD.EXE"
    Call SplitPath(sSourcePath, sDrive, sPath, sFilename, sExtension)
'// Ausgabe ----------------------------------------------------------------
    Debug.Print "Originalpfad: "; sSourcePath
    Debug.Print "Laufwerk: "; sDrive
    Debug.Print "Pfad: "; sPath
    Debug.Print "Dateiname: "; sFilename
    Debug.Print "Dateierweiterung: "; sExtension
'// ------------------------------------------------------------------------
'// Originalpfad: C:\Programme\Microsoft Office\Office10\WINWORD.EXE
'// Laufwerk: C:
'// Pfad: Programme\Microsoft Office\Office10
'// Dateiname: WINWORD
'// Dateierweiterung: EXE
'// ------------------------------------------------------------------------
End Sub
Code eingefügt mit dem MOF Code Converter

Lösung 3: API

Die hier vorgestellte API Lösung setzt voraus, dass auf dem System die Datei Shlwapi.dll in der Version 4.71 oder höher vorliegt. Dies in dann der Fall, wenn der Internet Explorer 4.0 oder höher installiert ist. Wie man nachfolgend sehen kann, ist der API-Weg deutlich aufwendiger:

Code:

Declare Function PathFindExtension Lib "shlwapi" Alias _
                "PathFindExtensionA" _
                (ByVal pPath As String) As Long
 
Declare Function PathFindFileName Lib "shlwapi" Alias _
                "PathFindFileNameA" _
                (ByVal pPath As String) As Long
 
Declare Function PathFindNextComponent Lib "shlwapi" Alias _
                "PathFindNextComponentA" _
                (ByVal pPath As String) As Long
 
Declare Function PathStripToRoot Lib "shlwapi" Alias _
                "PathStripToRootA" _
                (ByVal pPath As String) As Long
 
Declare Function lstrcpyA Lib "kernel32" _
                (ByVal RetVal As String, _
                 ByVal Ptr As Long) As Long
 
Declare Function lstrlenA Lib "kernel32" _
                (ByVal Ptr As Any) As Long
 
Sub SplitPath(ByVal sSourcePath As String, ByRef sDrive As String, _
              ByRef sPath As String, ByRef sFilename As String, _
              ByRef sExtension As String)
'// ------------------------------------------------------------------------
'// Laufwerk extrahieren
'// ------------------------------------------------------------------------
    sDrive = sSourcePath
    Call PathStripToRoot(sDrive): sDrive = TrimNull(sDrive)
'// ------------------------------------------------------------------------
'// Dateiname extrahieren
'// ------------------------------------------------------------------------
    sFilename = GetStrFromPtrA(PathFindFileName(sSourcePath))
'// ------------------------------------------------------------------------
'// Dateiendung extrahieren
'// ------------------------------------------------------------------------
    sExtension = GetStrFromPtrA(PathFindExtension(sSourcePath))
'// ------------------------------------------------------------------------
'// Verzeichnis ermitteln
'// ------------------------------------------------------------------------
    sPath = sSourcePath
    sPath = GetStrFromPtrA(PathFindNextComponent(sPath))
    sPath = Left(sPath, Len(sPath) - (Len(sFilename) + 1))
'// ------------------------------------------------------------------------
'// Dateiname ohne Extension ermitteln
'// ------------------------------------------------------------------------
    sFilename = Left(sFilename, Len(sFilename) - Len(sExtension))
 
End Sub
 
Private Function TrimNull(sItem As String)
 
'// Sucht das erste Chr(0)-Zeichen im String und gibt den
'// String bis zu dieser Position zurück.
'// Kommt kein Chr(0)-Zeichen vor, wird der ganze String zurückgegeben.
    Dim iPos As Integer
    iPos = InStr(sItem, Chr$(0))
    If iPos Then
          TrimNull = Left$(sItem, iPos - 1)
    Else: TrimNull = sItem
    End If
 
End Function
 
Function GetStrFromPtrA(ByVal lpszA As Long) As String
 
'// Anhand der Speicheradresse einer Variablen wird
'// deren Wert ausgelesen und als String zurückgegeben
    GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
    Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
 
End Function
 
Sub Beispiel()
 
    Dim sDrive      As String
    Dim sPath       As String
    Dim sFilename   As String
    Dim sExtension  As String
    Dim sSourcePath As String
 
    sSourcePath = "C:\Programme\Microsoft Office\Office10\WINWORD.EXE"
    Call SplitPath(sSourcePath, sDrive, sPath, sFilename, sExtension)
'// Ausgabe ----------------------------------------------------------------
    Debug.Print "Originalpfad: "; sSourcePath
    Debug.Print "Laufwerk: "; sDrive
    Debug.Print "Pfad: "; sPath
    Debug.Print "Dateiname: "; sFilename
    Debug.Print "Dateierweiterung: "; sExtension
'// ------------------------------------------------------------------------
'// Originalpfad: C:\Programme\Microsoft Office\Office10\WINWORD.EXE
'// Laufwerk: C:\
'// Pfad: Programme\Microsoft Office\Office10
'// Dateiname: WINWORD
'// Dateierweiterung: .EXE
'// ------------------------------------------------------------------------
End Sub
Code eingefügt mit dem MOF Code Converter

Geändert von Stefan Kulpa (11.01.2003 um 12:48 Uhr).
Stefan Kulpa ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 20.07.2008, 10:07   #2
tomsic
Neuer Benutzer
Neuer Benutzer
Standard Lösung 2 geht einfacher

Wenn wir die Pfadangabe in einer Variable haben, brauchen wir nicht mehr nach dem "Backslash" zu suchen. Einfach die Länge des Pfadangabennamens + 1 Offset herausschneiden, oder?

Code:

sFilename = Mid(sPath, Len(sSourcePath) + 1)
tomsic ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 31.07.2013, 08:42   #3
filunski
Neuer Benutzer
Neuer Benutzer
Standard alter und neuer Dateipfad

Hallo @all
In einer seit ca. 10 Jahren aufgebauten "selbstgestrickten" Briefmarken-Datenbank geht es um tausende von Briefmarken-Bildern, die in einem filigranen Ordnersystem auf der FP verteilt sind.
Alles funktionierte Einwandfrei bis vor Jahr und Tag nach einem Wechsel von MS Update Version 2007 auf 2010 irgendwann die Anlagefelder integriert worden sind.
Jetzt habe ich zwei Probleme.
1. Man sieht wesentliche Teile des Bildpfades nicht mehr. Klicke ich in meinem DB auf das Anlage-Feld, sehe ich nur den Dateinamen und nicht mehr den dazugehörenden Pfad. Früher konnte ich mit der "Suchen und Ersetzen" Funktion den Bildpfad anpassen, wenn ich Ordner auf der FP verschoben oder im Namen geändert habe.
2. Die alte Aufruf-Prozedur für ein neues Bild funktioniert nicht mehr. Es funktioniert nur die neue Anlagefeld - Prozedur von Access2010.

Zur Veranschaulichung habe ich einen Screenshot gemacht, in der zwei Briefmarken abgebildet sind, die größe Marke links hat den alten Bildpfad zur Basis, der ist als Textfeld sichtbar. Die Master-ID = MID ist Teil des Bildnamens.
Die "alte Einlesprozedur" wurde durch einen MS-Update außer Kraft gesetzt und ich war gezwungen die neue Prozedur zu benutzen (kleine Briefmarke) rechts.
Wem kommt das Problem mit den beiden inkopatiblen Prozeduren bekannt vor und hat eventuell eine Lösung, wie man/ich die jetzt doppelten Detaipfade in zwei Feldern angesiedelt wieder verschmelzen kann....

__________________

Mit besten Grüßen und Glückauf!
filunski

Geändert von filunski (31.07.2013 um 08:44 Uhr).
filunski ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 03.09.2014, 08:20   #4
momal
Neuer Benutzer
Neuer Benutzer
Standard

Angenehm finde ich es, in diesem Fall den Haken bei "Automatische Syntaxüberprüfung" zu entfernen. Access markiert dann weiterhin fehlerhafte Programmsyntax, allerdings ohne jedesmal ein separates Fehlerfenster zu öffnen.

__________________

Unlock the key of your success by United States Naval Academy and 220-801 pdf.By using our latest New York University study material, you can easily pass RIVERBED exam.
momal ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 12:36 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.