Nach Datei suchen und abspeichern unter...

A

aniram

Mitglied
Hallo,

ich versuch mich grad ein bisschen mit VB6

Mein Problem nun:
Ich möchte nach einer bestimmten Datei (*.pst )suchen. Diese wird dann auch angezeigt.

Ich möchte diese Datei dann auf einem Laufwerk meiner Wahl abspeichern. Wie geht das?

Schonmal Danke!
 
Hallo

Gehen wir mal davon aus, das deine Datei incl. Pfad in einem Textfeld angezeigt wird.
Für dieses Beispiel nennen wir dieses Textfeld mal txtDatei
Als Beispiel soll diese Datei auf das Laufwerk d: verschoben werden. Dafür deklariere ich 3 Variablen.

Dim OldFile, NewDrive, NewFile as String

OldFile = txtDatei ' Alter Pfad in der Variable OldFile
NewDrive = "d" ' Hier wird das neue Laufwerk angegeben. Dies kann natürlich
' viel schöner über ein Drivecontrol gemacht werden.

NewFile = NewDrive & mid(txtdatei,2,len(txtdatei)) ' Hier wird einfach nur das erste
' Zeichen ( Laufwerksbuchstaben ausgeschnitten und gegen
' den neuen ausgetauscht )

Name OldFile as Newfile ' Hiermit wird die Datei verschoben

Du solltest dich mit dem DriveControl und den dazugehörigen Komponenten beschäftigen. Damit kannst du den Quell und den Zielpfad komfortabel eingeben.
 
Ich komm nicht weiter :(

Es sieht bissher so aus:
pst.jpg


Hier der Code:

Code: 
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpDateiname 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 GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpDateiname As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Const MAX_Ordner = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nDateigroesseHigh As Long
    nDateigroesseLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cDateiname As String * MAX_Ordner
    cAlternate As String * 14
End Type

Function StripNull(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNull = OriginalStr
End Function

Function DirScan(Ordner As String, Dateityp As String, Dateizaehler As Long, Ordnerzaehler As Long)
    Dim Dateiname As String
    Dim Ordnername As String
    Dim Ordnernamen() As String
    Dim Ordneranzahl As Long
    Dim i As Integer
    Dim Suche As Long
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer
    If Right(Ordner, 1) <> "\" Then Ordner = Ordner & "\"
    Ordneranzahl = 0
    ReDim Ordnernamen(Ordneranzahl)
    Cont = True
    Suche = FindFirstFile(Ordner & "*", WFD)
    If Suche <> INVALID_HANDLE_VALUE Then
        Do While Cont
        DoEvents
        Ordnername = StripNull(WFD.cDateiname)
        If (Ordnername <> ".") And (Ordnername <> "..") Then
            If GetFileAttributes(Ordner & Ordnername) And FILE_ATTRIBUTE_DIRECTORY Then
                Ordnernamen(Ordneranzahl) = Ordnername
                Ordnerzaehler = Ordnerzaehler + 1
                Ordneranzahl = Ordneranzahl + 1
                ReDim Preserve Ordnernamen(Ordneranzahl)
            End If
        End If
        Cont = FindNextFile(Suche, WFD)
        Loop
        Cont = FindClose(Suche)
    End If
    Suche = FindFirstFile(Ordner & Dateityp, WFD)
    Cont = True
    If Suche <> INVALID_HANDLE_VALUE Then
        While Cont
            Dateiname = StripNull(WFD.cDateiname)
            If (Dateiname <> ".") And (Dateiname <> "..") Then
                DirScan = DirScan + (WFD.nDateigroesseHigh * MAXDWORD) + WFD.nDateigroesseLow
                Dateizaehler = Dateizaehler + 1
                List1.AddItem Ordner & Dateiname
            End If
            Cont = FindNextFile(Suche, WFD)
        Wend
        Cont = FindClose(Suche)
    End If
    If Ordneranzahl > 0 Then
        For i = 0 To Ordneranzahl - 1
            DirScan = DirScan + DirScan(Ordner & Ordnernamen(i) & "\", Dateityp, Dateizaehler, Ordnerzaehler)
        Next i
    End If
End Function

Sub Search_Click()
    Dim SuchOrdner As String, FindStr As String
    Dim Dateigroesse As Long
    Dim NumFiles As Long, NumDirs As Long
    Screen.MousePointer = vbHourglass
    List1.Clear
    SuchOrdner = "c:\"
    FindStr = "*.pst"
    Dateigroesse = DirScan(SuchOrdner, FindStr, NumFiles, NumDirs)
    Screen.MousePointer = vbDefault
End Sub

Private Sub End_Programm_Click()
End
End Sub

Es wird ja der komplette Pfad angegeben. Das mit den 3 Variablen habe ich nicht hinbekommen.
 
Zuletzt bearbeitet:
Es steht doch alles hier was du brauchst...

Füge deiner Form einen Button hinzu den wir cmdTest nennen.


Private Sub cmdTest_Click()
Dim OFile, NFile, NPath as Strring
NPath = "d" ' Hier könnte man mit einer Combobox, Listfeld oder dem CommonDialog
' einen Path aussuchen und übergeben

Ofile = List1.ListItem(0)
NFile = NPath & Mid(OFile,2,len(OFile))

Name OFile as NFile ' Hiermit wird der Pfad geändert und die Datei verschoben

End Sub


Probiers mal aus
 
Hat nicht ganz funktioniert. Folgender Fehler kommt. Im Quelltext wird das hier fettgedruckte markiert.

Fehler beim Kompilieren:
Methode oder Mitgliedsdaten nicht gefunden.


Code: 
Private Sub cmdTest_Click()
Dim OFile, NFile, NPath As String
NPath = "h" ' Hier könnte man mit einer Combobox, Listfeld oder dem CommonDialog
' einen Path aussuchen und übergeben

OFile = List1.ListItem(0)
NFile = NPath & Mid(OFile, 2, Len(OFile))

Name OFile As NFile ' Hiermit wird der Pfad geändert und die Datei verschoben

End Sub


Versteh ich nicht ganz.
 
Ich vermute mal, das du kein Listfeld verwendest. Wenn es geht poste doch bitte mal den Code

Es könnte natürlich auch sein, das der Aufruf vor dem befüllen der Listbox erfolgt
 
Hier der komplette Code
Code: 
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpDateiname 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 GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpDateiname As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Const MAX_Ordner = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nDateigroesseHigh As Long
    nDateigroesseLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cDateiname As String * MAX_Ordner
    cAlternate As String * 14
End Type

Function StripNull(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNull = OriginalStr
End Function

Function DirScan(Ordner As String, Dateityp As String, Dateizaehler As Long, Ordnerzaehler As Long)
    Dim Dateiname As String
    Dim Ordnername As String
    Dim Ordnernamen() As String
    Dim Ordneranzahl As Long
    Dim i As Integer
    Dim Suche As Long
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer
    If Right(Ordner, 1) <> "\" Then Ordner = Ordner & "\"
    Ordneranzahl = 0
    ReDim Ordnernamen(Ordneranzahl)
    Cont = True
    Suche = FindFirstFile(Ordner & "*", WFD)
    If Suche <> INVALID_HANDLE_VALUE Then
        Do While Cont
        DoEvents
        Ordnername = StripNull(WFD.cDateiname)
        If (Ordnername <> ".") And (Ordnername <> "..") Then
            If GetFileAttributes(Ordner & Ordnername) And FILE_ATTRIBUTE_DIRECTORY Then
                Ordnernamen(Ordneranzahl) = Ordnername
                Ordnerzaehler = Ordnerzaehler + 1
                Ordneranzahl = Ordneranzahl + 1
                ReDim Preserve Ordnernamen(Ordneranzahl)
            End If
        End If
        Cont = FindNextFile(Suche, WFD)
        Loop
        Cont = FindClose(Suche)
    End If
    Suche = FindFirstFile(Ordner & Dateityp, WFD)
    Cont = True
    If Suche <> INVALID_HANDLE_VALUE Then
        While Cont
            Dateiname = StripNull(WFD.cDateiname)
            If (Dateiname <> ".") And (Dateiname <> "..") Then
                DirScan = DirScan + (WFD.nDateigroesseHigh * MAXDWORD) + WFD.nDateigroesseLow
                Dateizaehler = Dateizaehler + 1
                List1.AddItem Ordner & Dateiname
            End If
            Cont = FindNextFile(Suche, WFD)
        Wend
        Cont = FindClose(Suche)
    End If
    If Ordneranzahl > 0 Then
        For i = 0 To Ordneranzahl - 1
            DirScan = DirScan + DirScan(Ordner & Ordnernamen(i) & "\", Dateityp, Dateizaehler, Ordnerzaehler)
        Next i
    End If
End Function

Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single)

End Sub


Private Sub Command1_Click()
Dim OFile, NFile, NPath As String
NPath = "h" ' Hier könnte man mit einer Combobox, Listfeld oder dem CommonDialog
' einen Path aussuchen und übergeben

OFile = List1.ListItem(1)
NFile = NPath & Mid(OFile, 2, Len(OFile))

Name OFile As NFile ' Hiermit wird der Pfad geändert und die Datei verschoben

End Sub

Sub Search_Click()
    Dim SuchOrdner As String, SuchOrdner2 As String, FindStr As String, FindStr2 As String
    Dim Dateigroesse As Long
    Dim NumFiles As Long, NumDirs As Long
    Screen.MousePointer = vbHourglass
    List1.Clear
    SuchOrdner = "c:\"
    FindStr = "*.pst"
    Dateigroesse = DirScan(SuchOrdner, FindStr, NumFiles, NumDirs)
    SuchOrdner2 = "h:\"
    FindStr2 = "*.pst"
    Dateigroesse = DirScan(SuchOrdner2, FindStr2, NumFiles, NumDirs)
    Screen.MousePointer = vbDefault
End Sub
Private Sub End_Programm_Click()
End
End Sub
So sieht das Programm ungefähr aus. Anstatt "speichern" ist jetzt der Button "Command1" drin. In der Listbox werden die Ergebnisse angezeigt.
Programm
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück