Anzeige
Archiv - Navigation
684to688
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
684to688
684to688
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
For...Next Schleife
26.10.2005 19:13:26
Metin
Hallo Excel Gemeinde
Hab ein Problem mit dem Makro wie kann ich hier eine Schleife einbauen, so das es alle Laufwerksbuchstaben durchläuft.

Sub Datei_suchen()
Dim strOrdner As String, _
strNamensteil As String, _
strSF As Byte, _
FS As FileSearch, _
i As Integer
strNamensteil = "Programmname"
strOrdner = "c:"
Set FS = Application.FileSearch
With FS
.LookIn = strOrdner
.Filename = strNamensteil & "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open (.FoundFiles(i))
MsgBox (.FoundFiles(i))
Next i
End If
End With
End Sub

Danke für eure Mühen
Gruß Metin

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: For...Next Schleife
26.10.2005 19:34:52
Josef
Hallo Metin!
Z.B. so!
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

'Deklaration: Globale Form API-Funktionen
Private Declare Function GetDriveType Lib "Kernel32" Alias _
  "GetDriveTypeA" ( _
  ByVal nDrive As String) As Long

Private Declare Function GetLogicalDriveStrings Lib "Kernel32" _
  Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
  ByVal lpBuffer As String) As Long

Private Function getDrives(ByRef vArr() As Variant)
'Deklaration: Lokale Prozedur-Variablen
Dim lngErgebnis As Long
Dim lngPuffer As Long
Dim lngTyp As Long
Dim x As Long, k As Integer
Dim tmp() As Variant
Dim strLaufwerk As String
Dim strLaufwerke As String
Dim strPuffer As String

'Speicherplatz reservieren
lngPuffer = 64
strPuffer = Space$(lngPuffer)

'Laufwerksbuchstaben ermitteln
lngErgebnis = GetLogicalDriveStrings(lngPuffer, strPuffer)
strLaufwerke = Left$(strPuffer, lngErgebnis)

Do While x < Len(strPuffer)
  x = InStr(strPuffer, vbNullChar)
  
  If x <> 0 Then
    strLaufwerk = Left$(strPuffer, x)
    strPuffer = Mid$(strPuffer, x + 1, Len(strPuffer))
    
    'Laufwerkstyp ermitteln
    lngTyp = GetDriveType(strLaufwerk)
    If lngTyp <> 1 Then
      Redim Preserve tmp(k)
      tmp(k) = UCase(Mid$(strLaufwerk, 1, 2))
      k = k + 1
      
    End If
  Else
    Exit Do
  End If
Loop
vArr = tmp
End Function



Sub Datei_suchen()
Dim strNamensteil As String, _
  arrDrives() As Variant, _
  FS As FileSearch, _
  i As Integer, n As Integer

strNamensteil = "Programmname"

getDrives arrDrives

Set FS = Application.FileSearch

For n = 0 To UBound(arrDrives)
  With FS
    .LookIn = arrDrives(n)
    .Filename = strNamensteil & "*.xls"
    .SearchSubFolders = True
    
    If .Execute > 0 Then
      For i = 1 To .FoundFiles.Count
        Workbooks.Open (.FoundFiles(i))
        MsgBox (.FoundFiles(i))
      Next i
    End If
  End With
Next

Set FS = Nothing
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: For...Next Schleife
26.10.2005 19:36:42
Erich
Hallo Metin,
das könnte so gehen (ungetestet):
(Vielleicht musst du noch eine Fehlerbehandlung einbauen für die nicht existierenden Laufwerke.
Wenn du nicht mit A:, sondern mit C: anfangen willst, kannst du die Schleife von 67 ab laufen lassen.)

Sub Datei_suchen()
Dim strOrdner As String, _
strNamensteil As String, _
strSF As Byte, _
FS As FileSearch, _
i As Integer, _
nn As Integer
strNamensteil = "Programmname"
Set FS = Application.FileSearch
With FS
For nn = 65 To 90
strOrdner = Chr(nn) & ":"     ' ergibt A: bis Z:
.LookIn = strOrdner
.Filename = strNamensteil & "*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open (.FoundFiles(i))
MsgBox (.FoundFiles(i))
Next i
End If
Next nn
End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: For...Next Schleife
26.10.2005 19:52:30
Metin
Hallo Erich
Danke für deine Hilfe
es kommt allerdings der Fehler Next ohne For
Hast du eine Idee.
AW: For...Next Schleife
26.10.2005 20:02:00
Nepumuk
Hi,
noch eine Möglichkeit:
Sub Datei_suchen()
    Dim strNamensteil As String, i As Integer
    Dim objFSO As Object, objDrive As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strNamensteil = "Programmname"
    For Each objDrive In objFSO.Drives
        If objDrive.IsReady Then
            With Application.FileSearch
                .LookIn = objDrive.Path
                .Filename = strNamensteil & "*.xls"
                .SearchSubFolders = True
                If .Execute > 0 Then
                    For i = 1 To .FoundFiles.Count
                        Workbooks.Open (.FoundFiles(i))
                        MsgBox (.FoundFiles(i))
                    Next
                End If
            End With
        End If
    Next
    Set objFSO = Nothing
End Sub

Gruß
Nepumuk

Anzeige
AW: Danke Nepumuk
26.10.2005 20:18:21
Metin
Es klappt
Gruß Metin
AW: For...Next Schleife
26.10.2005 20:35:46
Erich
Hallo Metin,
bitte vergiss meinen Quick-and-dirty-Versuch, die anderen Lösungen sind natürlich besser!
Ein Tipp noch, der auch bei allen Lösungen wichtig sein kann:
Du öffnest die gefundenen Dateien. Wenn du in zwei Verzeichnissen Dateien findes, die denselben (Kurz-)Namen haben (z. B. "C:\abc.xls" und "E:\Excelordner\Abc.xls"), wird beim Versuch, die zweite Datei zu öffnen, ein Fehler auftreten. In Excel kann nur eine Datei pro Kurzname geöffnet sein.
Grüße von Erich aus Kamp-Lintfort

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige