Dateien/Bilder von zwei Laufwerken einlesen

Hallo
ich habe nicht gesehen, dass du Office 97 verwendest.
Dort funktioniert der Code nicht. Da musst du das verwenden.

Sub Find_Files_for_Backup()
Dim i As Long, n As Integer, totFiles As Integer, tmps As Integer
Dim gefFile As String, dname As String
Dim Suchpfad As String, Suchbegriff As String, Dateiform As String
Dim oldStatus As Variant, msgTxt As String, Qe As Variant
Dim myFSO As Object
Set myFSO = CreateObject("Scripting.FileSystemObject")
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll:", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.jpg")
If Dateiform = "" Then Exit Sub
'Bildschirmaktualisier abschalten
Application.ScreenUpdating = True
'Text der Statusbar und alten Status aufnehmen
oldStatus = Application.StatusBar
'Start der Suchroutine
With Application.FileSearch
    .NewSearch
    .LookIn = Suchpfad
    .TextOrProperty = Suchbegriff
    .SearchSubFolders = True
    .FileType = Dateiform
    If .Execute() > 0 Then
        totFiles = .FoundFiles.Count
        'Ausgabe in Statusbar
        Application.StatusBar = "Total " & totFiles & " gefunden"
        For i = 1 To .FoundFiles.Count
            gefFile = .FoundFiles(i)
            tmps = 0
            'Extrahieren des Dateinamens für O97
            'Nicht nötig für E2000 und höher
            For n = 1 To Len(gefFile)
                If Mid(gefFile, n, 1) = "\" Then
                    tmps = n
                End If
            Next n
            'Für O97
            myFSO.MoveFile gefFile, "C:\Bildereinfügen\" & Right(gefFile, Len(gefFile) - tmps)
            'Für Excel 2000 und höher
            'myFSO.MoveFile gefFile, "C:\Bildereinfügen\" & Right(gefFile, Len(gefFile) - InStrRev(gefFile, "\", -1))
        Next i
    End If
End With
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gruss Rainer

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
ist zwar ungetestet aber probier mal

Sub Find_Files_for_Backup()
Dim i As Long, totFiles As Integer
Dim gefFile As String, dname As String
Dim Suchpfad As String, Suchbegriff As String, Dateiform As String
Dim oldStatus As Variant, msgTxt As String, Qe As Variant
Dim myFSO As Object
Set myFSO = CreateObject("Scripting.FileSystemObject")
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll:", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.jpg")
If Dateiform = "" Then Exit Sub
'Bildschirmaktualisier abschalten
Application.ScreenUpdating = True
'Text der Statusbar und alten Status aufnehmen
oldStatus = Application.StatusBar
'Start der Suchroutine
With Application.FileSearch
    .NewSearch
    .LookIn = Suchpfad
    .TextOrProperty = Suchbegriff
    .SearchSubFolders = True
    .FileType = Dateiform
    If .Execute() > 0 Then
        totFiles = .FoundFiles.Count
        'Ausgabe in Statusbar
        Application.StatusBar = "Total " & totFiles & " gefunden"
        For i = 1 To .FoundFiles.Count
            gefFile = .FoundFiles(i)
            myFSO.MoveFile gefFile, "C:\Bildereinfügen\" & Right(gefFile, Len(gefFile) - InStrRev(gefFile, "\", -1))
        Next i
    End If
End With
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

Dateien/Bilder von zwei Laufwerken einlesen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread