Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
492to496
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
492to496
492to496
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Öffnen andere Arbeitsmappe als SUCHE

Öffnen andere Arbeitsmappe als SUCHE
29.09.2004 12:14:29
nose
Hallo,
meine Augen sind von der Archivsuche schon angora :o(
In meinem Laufwerk G:\ befinden sich mehrere Unterordner und in irgendeinem UnterUnterordner befindet sich die schreibgeschützte Datei XY.xls
Mit einem CommandButton möchte ich diese Datei XY.xls in Laufwerk G:\ suchen und mit Schreibschutz (nur lesen) öffnen.
Bitte um Eure kurzfristige Hilfe, wenn möglich.
Mit freundlichen Grüßen
nose

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Öffnen andere Arbeitsmappe als SUCHE
29.09.2004 17:45:05
Nepumuk
Hallo,
versuch es mal damit:


Option Explicit
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As LongAs Long
Private Enum FILE_ATTRIBUTE
    MAX_PATH = 260
    INVALID_HANDLE_VALUE = -1
    FILE_ATTRIBUTE_ARCHIVE = &H20
    FILE_ATTRIBUTE_DIRECTORY = &H10
    FILE_ATTRIBUTE_HIDDEN = &H2
    FILE_ATTRIBUTE_NORMAL = &H80
    FILE_ATTRIBUTE_READONLY = &H1
    FILE_ATTRIBUTE_SYSTEM = &H4
    FILE_ATTRIBUTE_TEMPORARY = &H100
End Enum
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
Private strFile As String
Private bolfound As Boolean
Public Sub start()
    FindFiles "D:\", "zzz*.xls"
    If Not bolfound Then
        MsgBox "Keine Datei gefunden.", 48, "Hinweis"
    Else
        Workbooks.Open strFile, ReadOnly:=True
    End If
End Sub
Private Sub FindFiles(ByVal strFolderPath As StringByVal strSearch As String)
    Dim WFD As WIN32_FIND_DATA
    Dim lngSearch As Long
    Dim strDirName As String
    If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
    lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        GetFilesInFolder strFolderPath, strSearch
        Do
            If bolfound Then Exit Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
                strDirName = TrimNulls(WFD.cFileName)
                If (strDirName <> ".") And (strDirName <> "..") Then FindFiles strFolderPath & strDirName, strSearch
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub
Private Sub GetFilesInFolder(ByVal strFolderPath As StringByVal strSearch As String)
    Dim WFD As WIN32_FIND_DATA
    Dim lngSearch As Long
    Dim strFileName As String
    If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
    lngSearch = FindFirstFile(strFolderPath & strSearch, WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY Then
                strFileName = TrimNulls(WFD.cFileName)
                bolfound = True
                strFile = strFolderPath & strFileName
                Exit Do
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub
Private Function TrimNulls(ByVal strStringIn As StringAs String
    If InStr(strStringIn, Chr(0)) > 0 Then strStringIn = Left$(strStringIn, InStr(strStringIn, Chr(0)) - 1)
    TrimNulls = strStringIn
End Function


Das dürfte die schnellste Methode sein die du findest.
Gruß
Nepumuk
Anzeige
AW: Öffnen andere Arbeitsmappe als SUCHE
nose
Hallo Nepumuk,
vielen Dank für Deine besonderen Bemühungen.
Wie Du aus meinem Profil erkennen kannst, bin ich noch Anfänger in Exel.
Es tut mir leid, Dir sagen zu müssen, dass ich mit Deiner Hilfe einfach überfordert bin.
Ich habe mir die Angelegenheit nicht so umfangreich und kompliziert vorgestellt.
Aber vielleicht ist ein anderer Experte froh, diese Hilfe einmal anwenden zu können.
Nochmal ganz herzlichen Dank an Dich !!!

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige