Datei im Laufwerk finden

Sub Suche() Dim Dateiname As String Dim Datei As String Datei = "*.xlsx" Dim Projekt As String Projekt = 'Bezeichnung in der Datei Dim Pfad As String Pfad = 'Laufwerkname Dateiname = Pfad & "*" & "\" & Projekt & Datei If Dateiname "" Then Workbooks.Open Dateiname End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Laufwerksbuchstabe() Dim objDrive As Object Dim colDrives As Object Dim bolDrive As Boolean Dim strLaufwerk As String Dim objFSO As Object Set objFSO = CreateObject("Scripting.Filesystemobject") Set colDrives = objFSO.Drives For Each objDrive In colDrives If InStr(objDrive.ShareName, "Projekte") > 0 Then 'hier den Namen des _ Netzlaufwerks ändern strLaufwerk = objDrive.DriveLetter bolDrive = True End If Next objDrive If bolDrive = False Then MsgBox "Das erforderliche Netzlaufwerk wurde nicht gefunden!", vbOKOnly + _ vbCritical, "Fehler" Exit Sub End If MsgBox "Der Laufwerksbuchstabe lautet " & strLaufwerk & "." Set objFSO = Nothing End Sub

Hallo Tina,
teste mal:

Option Explicit

Private Declare Function SearchTreeForFile Lib "imagehlp.dll" ( _
    ByVal RootPath As String, _
    ByVal InputPathName As String, _
    ByVal OutputPathBuffer As String) As Long

Private Const MAX_PATH As Long = 260&

Public Sub Tina_sucht()

    Const DRIVE_NAME As String = "Projekte"
    Const FILE_EXTENSION As String = "*.xlsx"

    Dim objFileSystemObject As Object, objDrives As Object, objDrive As Object
    Dim objWorkbook As Workbook
    Dim blnFoundDrive As Boolean, blnFoundFile As Boolean
    Dim strPath As String, strProject As String
    Dim lngReturn As Long

    strProject = "Häufigkeit" & FILE_EXTENSION 'Anpassen !!!

    Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set objDrives = objFileSystemObject.Drives

    For Each objDrive In objDrives

        With objDrive

            If .IsReady Then

                If InStr(.ShareName, DRIVE_NAME) > 0 Then

                    blnFoundDrive = True
                    strPath = String$(MAX_PATH, vbNullChar)
                    lngReturn = SearchTreeForFile(.DriveLetter & ":\", strProject, strPath)

                    If lngReturn <> 0 Then

                        blnFoundFile = True
                        strPath = Left$(strPath, InStr(1, strPath, vbNullChar) - 1)
                        Exit For

                    End If
                End If
            End If
        End With
    Next

    If blnFoundDrive Then
        If blnFoundFile Then
            Set objWorkbook = Workbooks.Open(Filename:=strPath)

            'mach was mit dem Workbook

            Call objWorkbook.Close(SaveChanges:=False) 'oder True
            Set objWorkbook = Nothing
        Else
            Call MsgBox("Datei nicht gefunden.", vbCritical, "Fehler")
        End If
    Else
        Call MsgBox("Laufwerk nicht gefunden.", vbCritical, "Fehler")
    End If

    Set objDrive = Nothing
    Set objDrives = Nothing
    Set objFileSystemObject = Nothing
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread