For...Next Schleife

Forumthread: For...Next Schleife

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

AW: For...Next Schleife

26.10.2005 19:34:52

Josef
AW: For...Next Schleife

26.10.2005 19:36:42

Erich
AW: For...Next Schleife

26.10.2005 19:52:30

Metin
AW: For...Next Schleife

26.10.2005 20:02:00

Nepumuk
AW: Danke Nepumuk

26.10.2005 20:18:21

Metin
AW: For...Next Schleife

26.10.2005 20:35:46

Erich

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!
'******************************

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

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

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

Beliebteste Forumthreads (12 Monate)

Forumthread: For...Next Schleife

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread