Automatisches Suchen und Speichern von Filmen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Automatisches Suchen und Speichern von Filmen
von: Jürgen
Geschrieben am: 09.04.2005 11:57:12
Hallo zusammen,
noch immer sitze ich an meiner Datei für meinen Arbeitgeber. Nachdem ich nun per Makro alle Symbol- und Menüleisten beim Start ausblende, habe ich massig Platz, jede Menge Daten anzuzeigen.
Durch anklicken einer Graphik (Firmenlogo) wird ein Film mittels Hyperlink gestartet. Dies funkioniert bei mir auch einwandfrei!
Jetzt ergibt sich jedoch folgendes Problem:
Bei vielen Kollegen ist der Film ("Unternehmen.mpg") in einem anderen Ordner der Festplatte (C:\) gespeichert, wodurch der Hyperlink vor der ersten Benutzung angepasst werden müsste. Dies ist jedoch nicht ganz einfach, da die Arbeitsblätter jeweils mit einem Blattschutz versehen sind und alle Menü- und Symbolleisten ausgeblendet sind.
Gibt es vielleicht die Möglichkeit, dieses Problem mittels VBA zu lösen?
Im Grunde müsste hier ein Makro arbeiten, das
- erst die Datei "Unternehmen.mpg" sucht
- sich den Speicherort für spätere Verwendungen merkt und
- dann den Film startet.
Jedoch soll das Makro nicht bei jedem Start die komplette Festplatte nach der Datei durchsuchen (würde wahrscheinlich zu lange dauern), sondern sich den Speicherort merken und bei jedem weiteren Start prüfen, ob die Datei noch an dem gleichen Ort gespeichert ist. (Falls ja, dann den Film starten, falls nein, dann den Film suchen, speichern und starten).
Leider habe ich gar keine Ahnung, wie ich dies VBA-technisch lösen kann. Wer kann mir helfen?
Gruß Jürgen

Bild

Betrifft: AW: Automatisches Suchen und Speichern von Filmen
von: Rolf Beißner
Geschrieben am: 09.04.2005 16:59:59
Hallo Jürgen,
hier mal ein Beispiel,
wie du eine Exceldatei suchst + öffnest.
Vielleicht kann man das Suchverzeichnis
ja doch etwas eingrenzen, damit nicht immer
die ganze Platte durchforstet werden muss.
fG
Rolf
Option Explicit
'öffnet angegebene Arbeitsmappe d$

Sub file_find()
'Rolf Beißner
    Dim fso As Object, fs As Object
    Dim i As Integer
    Const d$ = "Unternehmen.xls"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set fso = Application.FileSearch
    With fso
        .NewSearch
        .LookIn = "C:\Filme\"
        .Filename = d$
        .SearchSubFolders = True
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                If UCase(d$) = UCase(fs.GetFileName(.FoundFiles(i))) Then
                    Workbooks.Open Filename:=.FoundFiles(i)
                    Exit For
                End If
            Next
        Else
            MsgBox "Datei " & d$ & " nicht gefunden"
        End If
    End With
End Sub

Bild

Betrifft: AW: Automatisches Suchen und Speichern von Filmen
von: Jürgen
Geschrieben am: 09.04.2005 17:36:56
Leider nicht, da manche Kollegen die Datei entweder direkt auf C: liegen haben, andere den Film in "Eigene Dateien" und wieder andere in "Filme" abgelegt haben.
Sichergestellt ist bzw. wird nur, dass die Datei Unternehmen.mpg heißt
Bild

Betrifft: AW: Automatisches Suchen und Speichern von Filmen
von: Rolf Beißner
Geschrieben am: 09.04.2005 17:47:19
Hallo Jürgen,
dann kommst du nicht umhin,
zumindest einmal die ganze Platte
durchsuchen zu lassen.
Kannst ja dann den Pfad, im Beispiel .FoundFiles(i),
in ein Tabellenblatt schreiben und dort abholen.
fG
Rolf
Bild

Betrifft: AW: Automatisches Suchen und Speichern von Filmen
von: Jürgen
Geschrieben am: 09.04.2005 19:31:47
Das wäre ja auch meine Idee. Das Makro müsste wie folgt aufgebaut sein:
- Schauen, ob bereits ein "Referenzwert" vorhanden ist.
- Wenn ja, dann prüfen, ob die Datei noch dort ist wo sie war (Referenzwert prüfen)
- Wenn ja, dann Datei aufrufen
- sonst komplette Suche auf Laufwerk C:\
- Wenn kein "Referenzwert" vorhanden ist (also beim ersten Start des Makro), komplette
Suche auf Laufwerk C:\
- Wenn komplette Suche nach "Unternehmen.mpg" nicht erfolgreich, dann Fehlermeldung
- sonst Speicherort als "Referenzwert" speichern (z.B. in Zelle Z1S15) und Datei aufrufen/abspielen.
Weißt du, wie man so ein Makro erstellt? Unter VBA kann man doch fast alles machen!
Mit dem Begriff .FoundFiles(i) kann ich als "Nicht-VBA-Experte" leider auch nichts anfangen.
Vielen Dank schon einmal im Voraus.
Jürgen
Bild

Betrifft: Film ab
von: Rolf Beißner
Geschrieben am: 09.04.2005 21:05:47
Hallo Jürgen,
versuch mal das
fG
Rolf
Option Explicit

Sub film_ab()
'Rolf Beißner
    Dim rng As Range
    Dim filmfile As String
    
    Set rng = ActiveSheet.Range("O1")
    
    If rng = "" Then
        filmfile = file_find
        If filmfile = "" Then
            MsgBox "Die Datei 'Unternehmen.mpg' ist nicht vorhanden"
            End
        Else
            rng = filmfile
            ActiveSheet.Hyperlinks.Add Anchor:=rng, Address:=rng.Formula _
                , TextToDisplay:="Film ab"
        End If
    End If
    rng.Hyperlinks(1).Follow
End Sub


Function file_find() As String
    Dim fso As Object, fs As Object
    Dim i As Integer
    Const d$ = "Unternehmen.mpg"
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set fso = Application.FileSearch
    With fso
        .NewSearch
        .LookIn = "C:\"
        .Filename = d$
        .SearchSubFolders = True
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                If UCase(d$) = UCase(fs.GetFileName(.FoundFiles(i))) Then
                    file_find = .FoundFiles(i)
                    Exit For
                End If
            Next
        Else
            file_find = ""
        End If
    End With
End Function

Bild

Betrifft: AW: Automatisches Suchen und Speichern von Filmen
von: Nepumuk
Geschrieben am: 09.04.2005 17:01:12
Hallo Jürgen,
ist es sichergestellt, dass sich die Datei auf dem C - Laufwerk befindet?
Gruß
Nepumuk
Bild

Betrifft: AW: Automatisches Suchen und Speichern von Filmen
von: Jürgen Schmidts
Geschrieben am: 09.04.2005 17:11:12
Der Film befindet sich definitv auf Laufwerk C:\
Bild

Betrifft: AW: Automatisches Suchen und Speichern von Filmen
von: Nepumuk
Geschrieben am: 10.04.2005 02:51:38
Hallo Jürgen,
dann geht das natürlich nicht mehr mit einem Hyperlink. Du musst der Grafik das Makro "Videostart" zuweisen.


Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
     ByVal lpClassName As StringByVal lpWindowName As StringAs Long
Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" ( _
     ByVal lpszLongPath As StringByVal lpszShortPath As StringByVal cchBuffer As LongAs Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hwnd As LongByVal lpOperation As StringByVal lpFile As String, _
    ByVal lpParameters As StringByVal lpDirectory As StringByVal nShowCmd As LongAs Long
     
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
    ByVal lpFILE_NAME 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 Const MAX_PATH = &H104
Private Const INVALID_HANDLE_VALUE = -&H1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const SW_SHOWNORMAL = &H1
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
    cFILE_NAME As String * MAX_PATH
    cAlternate As String * 14
End Type
Private Const FILE_NAME As String = "Unternehmen.mpg"
Private strFolder As String
Private bolfound As Boolean
Public Sub Videostart()
    Const FILE_PATH As String = "C:\"
    Dim strShortPath As String
    bolfound = False
    strFolder = GetSetting(Appname:="File", Section:="Path", Key:=FILE_NAME, Default:=Empty)
    If strFolder <> "" Then
        If Dir(strFolder & FILE_NAME) <> "" Then bolfound = True Else FindFiles FILE_PATH
    Else
        FindFiles FILE_PATH
    End If
    If bolfound Then
        SaveSetting Appname:="File", Section:="Path", Key:=FILE_NAME, setting:=strFolder
        strShortPath = Space(MAX_PATH)
        GetShortPathName strFolder & FILE_NAME, strShortPath, MAX_PATH
        ShellExecute FindWindow("XLMAIN", vbNullString), "open", strShortPath, _
            vbNullString, strFolder, SW_SHOWNORMAL
    Else
        MsgBox "Datei ''" & FILE_NAME & "'' nicht gefunden.", 16, "Fehlermeldung"
    End If
End Sub
Private Sub FindFiles(ByVal strFolderPath As String)
    Dim WFD As WIN32_FIND_DATA
    Dim lngSearch As Long
    Dim strDirName As String
    lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        GetFilesInFolder strFolderPath
        Do
            If bolfound Then Exit Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
                strDirName = Left$(WFD.cFILE_NAME, InStr(WFD.cFILE_NAME, Chr(0)) - 1)
                If (strDirName <> ".") And (strDirName <> "..") Then _
                    FindFiles strFolderPath & strDirName & "\"
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub
Private Sub GetFilesInFolder(ByVal strFolderPath As String)
    Dim WFD As WIN32_FIND_DATA
    Dim lngSearch As Long
    lngSearch = FindFirstFile(strFolderPath & FILE_NAME, WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY Then
            bolfound = True
            strFolder = strFolderPath
        End If
    End If
    FindClose lngSearch
End Sub


Gruß
Nepumuk
Bild

Betrifft: MPG-Datei via Hyperlink starten
von: Rolf Beißner
Geschrieben am: 10.04.2005 09:19:02
Hallo Nepumuk,
geht bei mir mit dem Mediaplayer völlig problemlos.
Herzl.Grüße + schönen Sonntag
Rolf
Bild

Betrifft: AW: MPG-Datei via Hyperlink starten
von: Jürgen
Geschrieben am: 11.04.2005 21:57:02
Vielen Dank euch beiden für die super Hilfe!
An dieser Stelle MUSS ich erste einmal ein RIESENGROßES Lob aussprechen für die tolle Hilfe, die solche VBA-Experten wie ihr uns totalen Anfängern in Sachen VBA bietet!!!
Viele Grüße
Jürgen
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Automatisches Suchen und Speichern von Filmen"