For...Next Schleife

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

For...Next Schleife

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

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread