VB pfad einer datei bestimmen

[Antibiotik]

hallo zusammen,

ich will das ich den pfad einer datei bekomm (z.B. MSExcel)!!

es gibt da auch eine funktion getfullpath, ob es allerdings die richtige ist, weiß ich net und Microsoft Hilfe liefert wieder mal nur Müll!!

Wisst ihr wie ich des am besten machen kann??

Ciao

Antibiotik

[Patte]

Versuch es mal hiermit:

' Langen Dateinamen ermitteln

Public Function GetLongName(ByVal sShortName As String) As String

Dim sOrdner() As String

Dim sLongName As String

Dim i As Integer

Dim sTemp As String

Dim iCount As Integer

' Falls Fehler auftritt, wird der kurze

' Dateiname zurückgegeben

GetLongName = sShortName

' Gesamtpfad in die einzelnen Ordner zerlegen

sOrdner = Split(sShortName, "\")

iCount = UBound(sOrdner)

' Fehlerbehandlung aktivieren

On Error Resume Next

' Alle Ordner von hinten nach vorne durchlaufen

For i = iCount To 1 Step -1

Err = 0

If i = iCount Then

' langen Dateinamen ermitteln

sTemp = Dir$(sShortName)

If Err <> 0 Then Exit For

sLongName = sTemp + sLongName

Else

' langen Ordnernamen ermitteln

sTemp = Dir$(sShortName, vbDirectory + vbHidden)

If Err <> 0 Then Exit For

sLongName = sTemp & "\" & sLongName

End If

sShortName = Left$(sShortName, _

Len(sShortName) - Len(sOrdner(i)) - 1)

Next i

If Err = 0 Then GetLongName = sOrdner(0) & "\" & sLongName

End Function

Hoffe, das hilft Dir weiter!

[Antibiotik]

hallo,

den des geht auch nicht!!

der user soll nur die anwendung eingeben (z.B. MSEXCEL.EXE) und als ergebnis soll dann C:\Programme\Office\...\MSexcel.exe rauskommen!!

Ciao

Antibiotik

[Patte]

Dann must Du die Datei also erst suchen?

Guck mal unter: vb-archiv

Da gibt es massenweise gute Beispiele

[developer]

MODUL:

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long


Private Const MAX_PATH = 260

Private Const INVALID_HANDLE_VALUE = -1


Public Type FILETIME

   dwLowDateTime As Long

   dwHighDateTime As Long

End Type


'Das Ergebniss der FindFile-Funktion landet in dieser Struktur

Private Type WIN32_FIND_DATA

   dwFileAttributes As Long 'Dateiattribute

   ftCreationTime As FILETIME 'Erstellungsdatum

   ftLastAccessTime As FILETIME 'Letzter Zugriff

   ftLastWriteTime As FILETIME 'Letzte Speicherung

   nFileSizeHigh As Long 'Größe (Hi)

   nFileSizeLow As Long 'Größe (Lo)

   dwReserved0 As Long 'bedeutungslos

   dwReserved1 As Long 'bedeutungslos

   cFileName As String * MAX_PATH 'Dateiname

   cAlternate As String * 14 'Dos-Dateiname

End Type


'in diese Struktur werden die Daten Transverriert um VBNullchars abzuschneiden

Public Type Datei

   Pfadname As String

   Dateiname As String

   DosDateiname As String

   ErstelltAM As FILETIME 'Diverse Api Funktionen sind nötig um die FileTime Struktur in ein Datum zu Konvertieren

   LetzterZugriff As FILETIME 'Darauf gehe ich hier eimal nicht ein, außerdem würde es die Suchroutine verlangsamen.

   LetzeÄnderung As FILETIME 'Schauen sie sich die API-Refferenz an um zu erfahren wie man diese Struktur in ein Datum Konvertiert.

   DateiGröße As Long

   Attribute As Long 'Kann man mit Entsprechenden Konstanten auswerten, auch dies finden sie in der Api Refferenz unter Dateisystem

End Type


Public WasFound() As Datei

Public StopSearch As Boolean


'Sucht nach der Datei, Wildcrads sind auch erlaubt (*.*, ?, ect.)

Public Function FindFile(ByVal StartPath As String, ByVal SearchSubfolder As Boolean, ByVal File As String, ByRef FileFound() As Datei)

   Dim hFile As Long, FileData As WIN32_FIND_DATA, Directories() As String, OnlyDirectories As Boolean, TmpFile As String

   DoEvents


   'Mögliche Backslash's abtrennen

   If Right$(StartPath, 1) = "\" Then StartPath = Left$(StartPath, Len(StartPath) - 1)


SearchOnlySubfolders:


   'sucht nach einer Datei, und packt das ergebnis in FileData

   hFile = FindFirstFile(StartPath & "\" & File & vbNullChar, FileData)


   'Wenn sie gefunden wurde, dann...

   If hFile <> INVALID_HANDLE_VALUE Then


      Do


         'Ist es ein Verzeichniss oder eine Datei ?

         If (FileData.dwFileAttributes And vbDirectory) = 0 Then 'Datei


            If Not OnlyDirectories Then 'Nur wenn nicht nur Verzeichinsse gesucht werden


               'Array um eins erhöhen und Daten ins Array übergeben

               On Error GoTo Err_DimFile

               ReDim Preserve FileFound(UBound(FileFound) + 1)

               On Error GoTo 0


               DoEvents

               UmPacken FileFound(UBound(FileFound)), FileData, StartPath & "\" & File


            End If

            If StopSearch = True Then Exit Function

         ElseIf SearchSubfolder = True Then 'Verzeichniss


            'Verzeichnis nur im Array Speichern wenn es über dem jetzigen liegt d.h. ".." "." sind nicht gültig

            If Left$(FileData.cFileName, InStr(FileData.cFileName, vbNullChar) - 1) <> "." And Left$(FileData.cFileName, InStr(FileData.cFileName, vbNullChar) - 1) <> ".." Then


               On Error GoTo Err_DimDir

               ReDim Preserve Directories(UBound(Directories) + 1)

               On Error GoTo 0


               'Verzeichnis dem Array Hinzufügen

               Directories(UBound(Directories)) = Left$(FileData.cFileName, InStr(FileData.cFileName, vbNullChar) - 1)

               End If

            End If


         DoEvents

      Loop Until FindNextFile(hFile, FileData) = 0 Or StopSearch = True


   End If

   FindClose hFile


   'Unteroder Durchsuchen

   On Error GoTo Err_DimDir

   If SearchSubfolder = False Or StopSearch = True Then Exit Function

   On Error GoTo 0


   'Wenn nach anderen Dateien als *.* gesucht wird, werden keine Ordner gefunden, darum noch einmal nach Ordnern suchen

   If Not OnlyDirectories And SearchSubfolder = True And File <> "*.*" Then

      OnlyDirectories = True

      TmpFile = File

      File = "*.*"

      GoTo SearchOnlySubfolders

   ElseIf TmpFile <> "" Then

      File = TmpFile

   End If


   On Error GoTo Err_Exit

   For i = 0 To UBound(Directories)

      If StopSearch = True Then Exit Function

      DoEvents


      'An diesem Punkt ruft die Funktion sich selbst für jeden Unterordner auf

      FindFile StartPath & "\" & Directories(i), SearchSubfolder, File, FileFound


   Next i


   Exit Function

Err_DimFile:

   ReDim FileFound(0)

   Resume Next

Err_DimDir:

   ReDim Directories(0)

   Resume Next

Err_Exit:

End Function


'Packt die Infos um und schneidet Nullchar zeichen ab

Private Function UmPacken(ByRef D As Datei, FD As WIN32_FIND_DATA, ByVal Path As String)

   With FD

      D.Attribute = .dwFileAttributes

      D.DateiGröße = .nFileSizeLow

      D.Dateiname = Left$(.cFileName, InStr(.cFileName, vbNullChar) - 1)

      D.DosDateiname = Left$(.cAlternate, InStr(.cAlternate, vbNullChar) - 1)

      If D.DosDateiname = "" Then D.DosDateiname = D.Dateiname

      D.ErstelltAM = .ftCreationTime

      D.LetzeÄnderung = .ftLastWriteTime

      D.LetzterZugriff = .ftLastAccessTime

      D.Pfadname = Left$(Path, InStrRev(Path, "\") - 1)


   End With

End Function


[/PHP]

Funktion:

[PHP]
Private Function StartSearch(Optional ByVal bSearch As Boolean = True)
Dim D() As Datei
On Error GoTo NoFileFound 'Ein fehler wird Ausgelöst bei Ubound wenn D keine Felder hat

If bSearch = True Then 'Suche Starten
StopSearch = False 'Immmer sicher gehen das Stopsearch False ist, sonst wird die Suche nicht gestartet

If Text3.Text <> "" Then FindFile Text3.Text, True, "Datei.exe", D

Else 'Suche Stopppen
StopSearch = True
Exit Function
End If

For i = 0 To UBound(D)
MsgBox D(i).Pfadname & "\" 'Pfad

Next i

NoFileFound:

End Function