Exceldateien auf Festplatte

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Exceldateien auf Festplatte
von: Marcel
Geschrieben am: 18.11.2003 15:10:09

Ich habe folgendes Makro übernommen. Funktioniert soweit ganz gut. Nur habe ich keine Diskette im Laufwerk, da bricht das Makro mit Fehlermeldung ab. Meine beiden Festplatten, die ich durchsuchen möchte, haben die Buchstaben C und E.
Wie kann ich das unten stehende Makro modifizieren?
Danke
Marcel







Sub Write_All_ExcelFiles_in_worksheet()
'by Ramses
Dim myFSO As Object
Dim myDrvList, myDrv, mySpace
Dim Dateiform As String, myStr As String
Dim geffile As String
Dim i As Long, totFiles As Long, chkHype As Integer
Dim oldStatus As Variant
Set myFSO = CreateObject("Scripting.Filesystemobject")
Set myDrvList = myFSO.drives
Application.ScreenUpdating = True
oldStatus = Application.StatusBar
On Error GoTo myErrHandler
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
If Dateiform = "" Then
    Application.ScreenUpdating = True
    Exit Sub
End If
chkHype = MsgBox("Gefundene Dateien als Hyperlink anlegen", vbYesNo + vbInformation, "Hperlinks erstellen")
If chkHype = vbYes Then
    For Each myDrv In myDrvList
        With myDrvList
            myStr = "" & myDrv.DriveLetter & " - "
            If myDrv.drivetype = remote Then
                myStr = myStr & myDrv.sharename & ": "
            Else
                myStr = myStr & myDrv.volumename & ": "
            End If
            Set mySpace = myFSO.getdrive(myFSO.getdrivename(myDrv.DriveLetter & ":"))
        End With
        With Application.FileSearch
            .LookIn = mySpace
            .SearchSubFolders = False 'True für Suche in allen Unterverzeichnissen!!
            .Filename = Dateiform
            If .Execute() > 0 Then
                totFiles = .FoundFiles.Count
                Application.StatusBar = "Total " & totFiles & " in " & mySpace & ": gefunden "
                For i = 1 To .FoundFiles.Count
                    geffile = .FoundFiles(i)
                    'In Tabelle eintragen
                    Cells([A65536].End(xlUp).Row + 1, 1) = geffile
                    ActiveSheet.Hyperlinks.Add Anchor:=Cells([A65536].End(xlUp).Row, 1), Address:=geffile _
                        , TextToDisplay:=geffile
                Next i
            End If
        End With
    Next
Else
    For Each myDrv In myDrvList
        With myDrvList
            myStr = "" & myDrv.DriveLetter & " - "
            If myDrv.drivetype = remote Then
                myStr = myStr & myDrv.sharename & ": "
            Else
                myStr = myStr & myDrv.volumename & ": "
            End If
            Set mySpace = myFSO.getdrive(myFSO.getdrivename(myDrv.DriveLetter & ":"))
        End With
        With Application.FileSearch
            .LookIn = mySpace
            .SearchSubFolders = False 'True für Suche in allen Unterverzeichnissen!!
            .Filename = Dateiform
            If .Execute() > 0 Then
                totFiles = .FoundFiles.Count
                Application.StatusBar = "Total " & totFiles & " in " & mySpace & ": gefunden "
                For i = 1 To .FoundFiles.Count
                    geffile = .FoundFiles(i)
                    'In Tabelle eintragen
                    Cells([A65536].End(xlUp).Row + 1, 1) = geffile
                Next i
            End If
        End With
    Next
End If
ErrEntry:
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
MyExit:
Close #1
Exit Sub
myErrHandler:
Select Case Err
    Case 71
        myStr = myStr & "Datenträger nicht bereit"
End Select
Resume ErrEntry
End 

Sub 
Gruss Rainer
Bild


Betrifft: AW: Exceldateien auf Festplatte
von: Nepumuk
Geschrieben am: 18.11.2003 17:30:42

Hallo Rainer,
so geht's:

Option Explicit
Sub Write_All_ExcelFiles_in_worksheet()
'by Ramses
    Dim myFSO As Object
    Dim myDrvList, myDrv, mySpace
    Dim Dateiform As String, myStr As String
    Dim geffile As String
    Dim i As Long, totFiles As Long, chkHype As Integer
    Dim oldStatus As Variant
    Set myFSO = CreateObject("Scripting.Filesystemobject")
    Set myDrvList = myFSO.drives
    Application.ScreenUpdating = True
    oldStatus = Application.StatusBar
    On Error GoTo myErrHandler
    Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
    If Dateiform = "" Then
        Application.ScreenUpdating = True
        Exit Sub
    End If
    chkHype = MsgBox("Gefundene Dateien als Hyperlink anlegen", vbYesNo + vbInformation, "Hperlinks erstellen")
    If chkHype = vbYes Then
        For Each myDrv In myDrvList
            If myDrv.IsReady Then
                With myDrvList
                    myStr = "" & myDrv.DriveLetter & " - "
                    If myDrv.drivetype = 3 Then
                        myStr = myStr & myDrv.sharename & ": "
                    Else
                        myStr = myStr & myDrv.volumename & ": "
                    End If
                    Set mySpace = myFSO.getdrive(myFSO.getdrivename(myDrv.DriveLetter & ":"))
                End With
                With Application.FileSearch
                    .LookIn = mySpace
                    .SearchSubFolders = True 'True für Suche in allen Unterverzeichnissen!!
                    .Filename = Dateiform
                    If .Execute() > 0 Then
                        totFiles = .FoundFiles.Count
                        Application.StatusBar = "Total " & totFiles & " in " & mySpace & ": gefunden "
                        For i = 1 To .FoundFiles.Count
                            geffile = .FoundFiles(i)
                            'In Tabelle eintragen
                            Cells([A65536].End(xlUp).Row + 1, 1) = geffile
                            ActiveSheet.Hyperlinks.Add Anchor:=Cells([A65536].End(xlUp).Row, 1), Address:=geffile _
                                , TextToDisplay:=geffile
                        Next i
                    End If
                End With
            End If
        Next
    Else
        For Each myDrv In myDrvList
            If myDrv.IsReady Then
                With myDrvList
                    myStr = "" & myDrv.DriveLetter & " - "
                    If myDrv.drivetype = 3 Then
                        myStr = myStr & myDrv.sharename & ": "
                    Else
                        myStr = myStr & myDrv.volumename & ": "
                    End If
                    Set mySpace = myFSO.getdrive(myFSO.getdrivename(myDrv.DriveLetter & ":"))
                End With
                With Application.FileSearch
                    .LookIn = mySpace
                    .SearchSubFolders = True 'True für Suche in allen Unterverzeichnissen!!
                    .Filename = Dateiform
                    If .Execute() > 0 Then
                        totFiles = .FoundFiles.Count
                        Application.StatusBar = "Total " & totFiles & " in " & mySpace & ": gefunden "
                        For i = 1 To .FoundFiles.Count
                            geffile = .FoundFiles(i)
                            'In Tabelle eintragen
                            Cells([A65536].End(xlUp).Row + 1, 1) = geffile
                        Next i
                    End If
                End With
            End If
        Next
    End If
    
ErrEntry:
    Application.StatusBar = oldStatus
    Application.ScreenUpdating = True
MyExit:
    Close #1
    Exit Sub
    
myErrHandler:
    Select Case Err
        Case 71
            myStr = myStr & "Datenträger nicht bereit"
    End Select
    Resume ErrEntry
End Sub


Code eingefügt mit: Excel Code Jeanie

Gruß
Nepumuk


Bild


Betrifft: AW: Exceldateien auf Festplatte
von: Marcel
Geschrieben am: 19.11.2003 07:08:31

Sorry, habe das Makro von Rainer bekommen und beim Kopieren seinen Namen mitgenommen.
Vielen Dank.

Gruß Marcel


Bild


Betrifft: AW: Exceldateien auf Festplatte
von: Marcel
Geschrieben am: 19.11.2003 07:08:38

Sorry, habe das Makro von Rainer bekommen und beim Kopieren seinen Namen mitgenommen.
Vielen Dank.

Gruß Marcel


Bild

Beiträge aus den Excel-Beispielen zum Thema " Exceldateien auf Festplatte"