Herbers Excel-Forum - das Archiv

Automatisches Suchen und Speichern von Filmen

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
Excel-Beispiele zum Thema "Automatisches Suchen und Speichern von Filmen"
Automatisches Komplettieren einer Zelleingabe Zellinhalt suchen und Zelle auswählen
Suchbegriff über mehrere Tabellenblätter suchen. Suchen und weitersuchen
Zahl +/- 1 suchen Ein Zeichen in einer Formel suchen
Datum suchen und Wert eintragen Wert in Tabelle suchen und in UserForm ausgeben
Letzte Zelle mit Inhalt suchen Textdatei nach Begriff durchsuchen und Fundzeile importieren