Automatisierung, Excel: Alle Dateien aus Ordner mit Hyperlink?

Dieses Thema Automatisierung, Excel: Alle Dateien aus Ordner mit Hyperlink? im Forum "Microsoft Office Suite" wurde erstellt von ArcaneLion, 30. Aug. 2004.

Thema: Automatisierung, Excel: Alle Dateien aus Ordner mit Hyperlink? Ich möchte ein wenig Ordnung in meine Musiksammlung bringen. Ich dachte mir, ich mach mir ne Liste mir allen...

  1. Ich möchte ein wenig Ordnung in meine Musiksammlung bringen.
    Ich dachte mir, ich mach mir ne Liste mir allen Liedern, in der zweiten Spalte ne Kategorie und kann dann immer schön über nen Autofilder Das auswählen was ich grade hören will.

    Meine Frage ist jetzt:
    Kennt wer nen Trick wie ich alle Dateien aus meinem Mp3 Ordner (ohne Unterordner!) in Excel gleich mit Hyperlink auf die Datei einfügen kann?
    Als Name des Hyperlinks sollte immer nur der Dateiname selbst zu sehen sein.

    Danke schonmal!
     
  2. Prototyp ist per mail unterwegs.

    Gruß Matjes :)
     
  3. also erstmal keine Antwort :mad:

    Dann hier zum mitlesen:

    Excel 97
    mp3VerzeichnisAuflistenAlsHyperlink()
    Makro zum Auflisten der mp3-Files eines Directories

    Die Ausgabe erfolgt in einem neu angelegten Blatt

    a) mit Auswahl des Pfades
    b) fester Filter *.mp3 für Dateinamen
    c) Hyperlink wird nur mit Dateinamen angezeigt

    Code:
    Option Explicit
    '© 2004 Matthias Köhler, [email]Matthias.Koehler.KOE@t-online.de[/email]
    
    
    ' Typdeklaration für API-Dialog->Verzeichnis auswählen'
        Private Type BrowseInfo
            hOwner          As Long
            pidlRoot        As Long
            pszDisplayName  As String
            lpszTitle       As String
            ulFlags         As Long
            lpfn            As Long
            lParam          As Long
            iImage          As Long
        End Type
    
        Private Declare Function SHGetPathFromIDList Lib shell32.dll (ByVal pidl As Long, ByVal pszPath As String) As Long
        Private Declare Function SHBrowseForFolder Lib shell32.dll (lpBrowseInfo As BrowseInfo) As Long
    
    ' Ermittelt Verzeichnisnamen und zeigt Windows-Dialog an
    Public Function VerzeichnisWählen(Optional DialogTitel) As String
        Dim StrukturVerzeichnisInfo As BrowseInfo, ListenNr As Long, Pfad As String
        Dim hWndAccessApp As Long
      
        With StrukturVerzeichnisInfo
            .hOwner = hWndAccessApp
            .lpszTitle = IIf(IsMissing(DialogTitel), Verzeichnispfad auswählen, CStr(DialogTitel))
            .ulFlags = &H1-> BIF_RETURNONLYFSDIRS
        End With
        
        ListenNr = SHBrowseForFolder(StrukturVerzeichnisInfo)
        Pfad = Space$(512)
        
        If SHGetPathFromIDList(ByVal ListenNr, ByVal Pfad) Then VerzeichnisWählen = Left(Pfad, InStr(Pfad, vbNullChar) - 1)
        
    End Function
    
    
    
    Public Sub mp3VerzeichnisAuflistenAlsHyperlink()
    'Makro zum Auflisten der mp3-Files eines Directories
    '
    'Die Ausgabe erfolgt in einem neu angelegten Blatt
    '
    'a) mit Auswahl des Pfades
    'b) fester Filter *.mp3 für Dateinamen
    'c) Hyperlink wird nur mit Dateinamen angezeigt
    Dim ws As Worksheet
    Dim fs As FileSearch
    Dim i As Long, z As Long
    Dim s_tmp As String, sSuchpfad As String
    Dim ret As Integer
    
     -> Auswahl des Pfades
      sSuchpfad = VerzeichnisWählen(Bitte wählen Sie das Verzeichnis)
    
      If sSuchpfad =  Then
        ret = MsgBox(Es wurde kein Suchpfad eingegeben ! & vbCrLf & Der Makro wird beendet., _
                vbOKOnly + vbInformation, Kein Suchpfad ausgewählt)
      Else
        
       ->neues Blatt anlegen
        Worksheets.Add After:=Worksheets(Worksheets.Count)
        Set ws = Worksheets(Worksheets.Count)
       ->Zeilenzähler für nächsten Eintrag initialisieren
        z = 1
       ->Überschrift
        ws.Cells(z, 1).Value = folgende mp3files befinden sich im Pfad  & sSuchpfad
        ws.Cells(z, 1).Font.Bold = True
        z = z + 2->Zeilenzaehler für naechsten Eintrag erhöhen
         
        ws.Cells(z, 1).Value = links zu mp3-files
        ws.Cells(z, 1).Font.Bold = True
        z = z + 1->Zeilenzaehler für naechsten Eintrag erhöhen
         
       ->Filenamen aus dem Directory sPath auflisten
         Set fs = Application.FileSearch
         
         With fs
            .NewSearch
            .LookIn = sSuchpfad
            .FileName = *.mp3
            i = .Execute(SortBy:=msoSortByFileName, _
                SortOrder:=msoSortOrderAscending)
            If .FoundFiles.Count > 0 Then
              For i = 1 To .FoundFiles.Count
                  s_tmp = .FoundFiles(i)
                  ws.Cells(z, 1).Value = NurFilenamen(s_tmp)->ohne Pfad
                  ws.Hyperlinks.Add Anchor:=ws.Cells(z, 1), Address:=s_tmp
                  z = z + 1->Zeilenzaehler für naechsten Eintrag erhöhen
              Next i
            Else
              ws.Cells(z, 1).Value = kein File vorhanden :-(
              MsgBox Keine Dokumente gefunden
            End If
         End With
         ws.Columns(1).AutoFit
      End If
    End Sub
    Private Function NurFilenamen(s_vollstaendigerFilename As String) As String
    'schneidet die Pfadangaben aus einem String und gibt den Filenamen zurueck
    Dim p1 As Integer, p2 As Integer
    
      p2 = 0: p1 = 0
      Do
        p1 = InStr(p1 + 1, s_vollstaendigerFilename, \)
        If p1 <> 0 Then p2 = p1
      Loop While p1 <> 0
      NurFilenamen = Right(s_vollstaendigerFilename, Len(s_vollstaendigerFilename) - p2)
    End Function
    
    
    
     
  4. Sorry!

    Die letzten Tage gingen ein wenig drunter und drüber...
    Neben viel Arbeitsstress, bin ich auf vielen Einsätzen gewesen (freiwillige Feuerwehr) und so weiter und so weiter...

    Nundenn:
    Jetzt mal zu den fröhlichen Dingen:
    Ich habe heute beide Mails erhalten.
    Von dem Mp3 Programm bin ich hin und weg. Echt genial!

    Das einzigste was mir fehlt, ist die Möglichkeit eine bereits angelgete Tabelle zu akutualisieren (neue Dateien nicht alphabetisch sortiert, sondern einfach unten angehangen). Aber das soll die Sache nicht schlechter machen und zudem währe es dreist von dir zu verlangen das noch einzubauen, nach der Müge die du dir sowieso schon gegeben hast...
    Neue CDs füge ich dann per Hand ein, sind ja meisten nur so 10 bis 20 Dateien!

    Also:
    Vielen Dank!!!
     
  5. Hallo ArcaneLion,

    entschuldige das Drängeln. ::)

    Hab dir noch ein Makro entsprechend deinem Wunsch drangehängt:

    Excel 97
    NeueMp3AlsHyperlinkAnVorhandeneListeAnfuegen()
    Anhängen neuer mp3-Files eines Directories an eine bestehende Liste

    Das Blatt mit der bereits vorhandene Liste muß aktiviert sein.

    a) Auflistung der mp3-files eines wählbaren Directories auf einem neu angelegten Tabellenblatt
    (mit Auswahl des Pfades, fester Filter *.mp3 für Dateinamen, Hyperlink nur mit Dateinamen)

    b) es wird die Spaltennummer des aktiven Blattes abgefragt, mit der die neue Liste verglichen werden soll

    c) die bereits vorhandenen mp3files-Hyperlinks werden auf dem neuen Tabellenblatt gelöscht

    d) die verbleibenden mp3files-Hyperlinks werden der alten Liste entsprechend der Spaltennummer unten angefügt

    e) das neue Tabellenblatt wird gelöscht

    Gruß Matjes ;)

    Code:
    Option Explicit
    '© 2004 Matthias Köhler, [email]Matthias.Koehler.KOE@t-online.de[/email]
    
    
    ' Typdeklaration für API-Dialog->Verzeichnis auswählen'
        Private Type BrowseInfo
            hOwner          As Long
            pidlRoot        As Long
            pszDisplayName  As String
            lpszTitle       As String
            ulFlags         As Long
            lpfn            As Long
            lParam          As Long
            iImage          As Long
        End Type
    
        Private Declare Function SHGetPathFromIDList Lib shell32.dll (ByVal pidl As Long, ByVal pszPath As String) As Long
        Private Declare Function SHBrowseForFolder Lib shell32.dll (lpBrowseInfo As BrowseInfo) As Long
        Const c_DateiFilter = *.mp3
    
    ' Ermittelt Verzeichnisnamen und zeigt Windows-Dialog an
    Public Function VerzeichnisWählen(Optional DialogTitel) As String
        Dim StrukturVerzeichnisInfo As BrowseInfo, ListenNr As Long, Pfad As String
        Dim hWndAccessApp As Long
      
        With StrukturVerzeichnisInfo
            .hOwner = hWndAccessApp
            .lpszTitle = IIf(IsMissing(DialogTitel), Verzeichnispfad auswählen, CStr(DialogTitel))
            .ulFlags = &H1-> BIF_RETURNONLYFSDIRS
        End With
        
        ListenNr = SHBrowseForFolder(StrukturVerzeichnisInfo)
        Pfad = Space$(512)
        
        If SHGetPathFromIDList(ByVal ListenNr, ByVal Pfad) Then VerzeichnisWählen = Left(Pfad, InStr(Pfad, vbNullChar) - 1)
        
    End Function
    Public Sub mp3VerzeichnisAuflistenAlsHyperlink()
      Dim b_ok As Boolean, l_Zanf As Long, l_Zend As Long
      b_ok = fkt_mp3VerzeichnisAuflistenAlsHyperlink(l_Zanf, l_Zend)
    End Sub
    Private Function fkt_mp3VerzeichnisAuflistenAlsHyperlink( _
                                        l_Zanf As Long, _
                                        l_Zend As Long) As Boolean
    'Makro zum Auflisten der mp3-Files eines Directories
    '
    'Die Ausgabe erfolgt in einem neu angelegten Blatt
    '
    'a) mit Auswahl des Pfades
    'b) fester Filter *.mp3 für Dateinamen
    'c) Hyperlink wird nur mit Dateinamen angezeigt
    Dim ws As Worksheet
    Dim fs As FileSearch
    Dim i As Long, z As Long
    Dim s_tmp As String, sSuchpfad As String
    Dim ret As Integer
      
     ->Rückgabekennung auf ok setzen
      fkt_mp3VerzeichnisAuflistenAlsHyperlink = True
      
     -> Auswahl des Pfades
      sSuchpfad = VerzeichnisWählen(Bitte wählen Sie das Verzeichnis)
    
      If sSuchpfad =  Then
        ret = MsgBox(Es wurde kein Suchpfad eingegeben ! & vbCrLf & Der Makro wird beendet., _
                vbOKOnly + vbInformation, Kein Suchpfad ausgewählt)
        fkt_mp3VerzeichnisAuflistenAlsHyperlink = False
      Else
        
       ->neues Blatt anlegen
        Worksheets.Add After:=Worksheets(Worksheets.Count)
        Set ws = Worksheets(Worksheets.Count)
       ->Zeilenzähler für nächsten Eintrag initialisieren
        z = 1
       ->Überschrift
        ws.Cells(z, 1).Value = folgende mp3files befinden sich im Pfad  & sSuchpfad
        ws.Cells(z, 1).Font.Bold = True
        z = z + 2->Zeilenzaehler für naechsten Eintrag erhöhen
         
        ws.Cells(z, 1).Value = links zu mp3-files
        ws.Cells(z, 1).Font.Bold = True
        z = z + 1->Zeilenzaehler für naechsten Eintrag erhöhen
        
       ->Filenamen aus dem Directory sPath auflisten
         Set fs = Application.FileSearch
         
         With fs
            .NewSearch
            .LookIn = sSuchpfad
            .FileName = c_DateiFilter
            i = .Execute(SortBy:=msoSortByFileName, _
                SortOrder:=msoSortOrderAscending)
            If .FoundFiles.Count > 0 Then
              For i = 1 To .FoundFiles.Count
                  If i = 1 Then l_Zanf = z
                  s_tmp = .FoundFiles(i)
                  ws.Cells(z, 1).Value = NurFilenamen(s_tmp)->ohne Pfad
                  ws.Hyperlinks.Add Anchor:=ws.Cells(z, 1), Address:=s_tmp
                  l_Zend = z
                  z = z + 1->Zeilenzaehler für naechsten Eintrag erhöhen
              Next i
            Else
              ws.Cells(z, 1).Value = kein File vorhanden :-(
              MsgBox Keine Dokumente gefunden
              fkt_mp3VerzeichnisAuflistenAlsHyperlink = False
            End If
         End With
         ws.Columns(1).AutoFit
      End If
    End Function
    Private Function NurFilenamen(s_vollstaendigerFilename As String) As String
    'schneidet die Pfadangaben aus einem String und gibt den Filenamen zurueck
    Dim p1 As Integer, p2 As Integer
    
      p2 = 0: p1 = 0
      Do
        p1 = InStr(p1 + 1, s_vollstaendigerFilename, \)
        If p1 <> 0 Then p2 = p1
      Loop While p1 <> 0
      NurFilenamen = Right(s_vollstaendigerFilename, Len(s_vollstaendigerFilename) - p2)
    End Function
    
    
    '***************************************************************
    Public Sub NeueMp3AlsHyperlinkAnVorhandeneListeAnfuegen()
    '***************************************************************
    'Anhängen neuer mp3-Files eines Directories an eine bestehende Liste
    '
    'Das Blatt mit der bereits vorhandene Liste muß aktiviert sein.
    '
    'a) Auflistung der mp3-files eines wählbaren Directories
    '   auf einem neu angelegten Tabellenblatt
    '   (mit Auswahl des Pfades, fester Filter *.mp3 für Dateinamen,
    '   Hyperlink nur mit Dateinamen)
    '
    'b) es wird die Spaltennummer des aktiven Blattes abgefragt,
    '   mit der die neue Liste verglichen werden soll
    '
    'c) die bereits vorhandenen mp3files-Hyperlinks werden
    '   auf dem neuen Tabellenblatt gelöscht
    '
    'd) die verbleibenden mp3files-Hyperlinks werden der alten Liste
    '   entsprechend der Spaltennummer unten angefügt
    '
    'e) das neue Tabellenblatt wird gelöscht
    '***************************************************************
      Dim l_Spaltennummer As Long, s_tmp As String
      Dim ws_a As Worksheet, ws_n As Worksheet
      Dim l_Zanf As Long, l_Zend As Long
      Dim l_Rows As Long, a As Long, n As Long, l_Rows2 As Long
      
     ->aktuelles Blatt merken
      Set ws_a = ActiveSheet
      
     ->a) Auflistung der mp3-files eines wählbaren Directories
     ->   auf einem neu angelegten Tabellenblatt
     ->   (mit Auswahl des Pfades, fester Filter *.mp3 für Dateinamen,
     ->   Hyperlink nur mit Dateinamen)
      If fkt_mp3VerzeichnisAuflistenAlsHyperlink(l_Zanf, l_Zend) = False Then
        Exit Sub
      End If
      Set ws_n = ActiveWorkbook.Worksheets(Worksheets.Count)
      
     ->b) es wird die Spaltennummer des aktiven Blattes abgefragt,
     ->   mit der die neue Liste verglichen werden soll
      ws_a.Activate
      l_Spaltennummer = 0
      Do
        s_tmp = InputBox( _
          Bitte geben Sie für den Vergleich die Spaltennummer & vbLf & _
          auf dem aktiven Tabellenblatt an (zulässig 1-10)., _
          Eingabe der Spaltennummer)
        Select Case s_tmp
          Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
            l_Spaltennummer = s_tmp
        End Select
      Loop While l_Spaltennummer = 0
    
     ->c) die bereits vorhandenen mp3files-Hyperlinks werden
     ->   auf dem neuen Tabellenblatt gelöscht
      l_Rows = ws_a.Cells(ws_a.Rows.Count, l_Spaltennummer).End(xlUp).Row
      For n = l_Zend To l_Zanf Step -1
        s_tmp = ws_n.Cells(n, 1).Value
        For a = 1 To l_Rows
          If s_tmp = ws_a.Cells(a, l_Spaltennummer).Value Then
           ->gleicher Eintrag in alt und neu -> neuen löschen
            ws_n.Rows(n).Delete
            Exit For
          End If
        Next
      Next
    
     ->d) die verbleibenden mp3files-Hyperlinks werden der alten Liste
     ->   entsprechend der Spaltennummer unten angefügt
      ws_n.Activate
      l_Rows2 = ws_n.Cells(ws_n.Rows.Count, 1).End(xlUp).Row
     ->ist was Neues übriggeblieben ?
      If l_Rows2 >= l_Zanf Then
        ws_n.Range(ws_n.Cells(l_Zanf, 1), ws_n.Cells(l_Rows2, 1)).Copy
        ws_a.Activate
        ws_a.Cells(l_Rows + 1, l_Spaltennummer).Select
        ws_a.Paste
        ws_a.Cells(l_Rows + 1, l_Spaltennummer).Select
      End If
    
     ->e) das neue Tabellenblatt wird gelöscht
      Application.DisplayAlerts = False
      ws_n.Delete
      Application.DisplayAlerts = True
      
      
      On Error Resume Next
      Set ws_a = Nothing: Set ws_n = Nothing
      On Error GoTo 0
    End Sub
    
     
  6. Guten Morgen Matjes,
    Hallo Forumsuser!

    mein erstes Posting hier ;)

    Ich bin über Google hierher gekommen, was VBA angeht - eher ein N00b, - sehr viel Try&Error und Copy and Paste - allerdings mit viel Enthusiasmus auf dem Wege der Besserung.

    Ich weiss nicht mehr recht, wonach ich gesucht habe, allerdings wollte ich mich ganz schnell für diesen absolut hilfreichen Code bedanken, über den ich mehr oder minder gestolpert bin.

    Ich möchte zwar keinen Index für mp3´s erstellen, eher *xls, docs etc.

    Schön wäre es, wenn das Script nicht nur die erste Hierachiestufe der Ordner auslesen würde, sondern quasi auch alle Unterordner.

    Egal
    Klasse Support Matjes

    regards
    Senyavin
     
  7. Hallo Senyavin,

    folgende Erweiterungen sind möglich:

    - Abfrage des Datei-Filters mit Vorgabe eines Default-Filters (*.mp3)
    (den kann man dann nach Belieben abändern)
    In der Handhabung für *.mp3 nur ein Ok-Button mehr

    - Abfrage, ob auch in Unterordnern gesucht werden soll
    (Nein -> bisheriges Verhalten, Ja -> Unterordner werden auch mit ausgegeben)
    Frage ist hier: wie sollen die files des jeweilge Unterverzeichnis ausgegeben werden und die Überschrift mit dem Verzeichnis
    a) einfach nur die files an die Liste anhängen
    b) eine Zwischen-Überschrift mit dem Verzeichnis und dann die files anhängen
    c) jedes Verzeichnis auf einem neuen Blatt anlegen
    d) wie soll der Makro Neue...Anhaengen reagieren
    (auf ein Verzeichnis oder auch mit Unterverzeichnissen)

    Das sind alles Fragen, die vor der Programmierung beantwortet sein sollten.


    Im bestehenden Makro kannst Du den Dateifilter deinen Belangen entsprechend anpassen. Einfach die Zeile
    Code:
    Const c_DateiFilter = *.mp3
    ändern, z.B. für Excel- und Textdateien:
    Code:
    Const c_DateiFilter = *.xls;*.txt
    Gruß Matjes :)
     
  8. Guten Morgen Matjes,

    vielen Dank für Dein Feedback, hatte garnicht damit gerechnet :eek:.

    Es sollte mehr ein only thx sein,
    ich hatte den Code in meine Bookmarksammlung übernommen, für spätere Verwendung quasi

    und wenn man sich schon kostenlos bedienen darf sollte ein kleines Dankeshön wohl das Mindeste sein.

    OK,
    ;) weil Du gerade fragst,

    für mich, wie oben erwähnt, wäre eine Indizierung sehr hilfreich.
    d.h. ich habe ein bestimmtes rootverzeichnis, von dem aus verzweigungen abgehen.

    die struktur sieht wie folgt aus

    /root/backup/files/2003
    /root/backup/files/2003/Mai/01
    /root/backup/files/2003/Mai/02
    /root/backup/files/2003/Mai/01
    /root/backup/files/2003/Mai/04
    /root/backup/files/2003
    /root/backup/files/2003/Juni/01
    /root/backup/files/2003/Juni/02
    /root/backup/files/2003/Juni/01
    /root/backup/files/2003/Juni/04
    .
    .
    .


    /root/backup/files/2004/September/09


    also die Ordner werden nach Tagesdatum erzeugt und in diesen befinden sich dann diverse dokumente/ exceldateien/ txtfiles



    /// snip
    wie sollen die files des jeweilge Unterverzeichnis ausgegeben werden und die Überschrift mit dem Verzeichnis


    Das Hauptpfad kann mit A1 beibehalten werden,
    eine Überschrift ist nicht zwingend erforderlich, eher ein Nice2Have
    Evtl. könnten unter A1 noch die jeweilieg Anzahl an Dateien gelistet werden
    /root/backup/files/2003

    ---
    a) einfach nur die files an die Liste anhängen


    Schön wäre es, wenn jedes Final Directory einen eigenen Index im Sheet hätte.
    Ordner Mai würde dann in Tabelle->Mai' wiedergegeben werden.

    ----


    ----
    b) eine Zwischen-Überschrift mit dem Verzeichnis und dann die files anhängen
    ----

    wäre eine klasse Lösung wenn man nur ein paar Files hätte, bei meinen Datenmengen würde es wohl mit der Zeit recht unübersichtlich werden.

    -----

    c) c) jedes Verzeichnis auf einem neuen Blatt anlegen


    das wäre ein wirklich nettes Feature

    -----

    --------------------
    d) wie soll der Makro Neue...Anhaengen reagieren
    (auf ein Verzeichnis oder auch mit Unterverzeichnissen)


    hmmm, gute Frage!

    ansich sollte der gesamte Verzeichnisbaum aktualisiert werden,
    in meinem Fall wäre dies nicht unbedingt von nöten, da die struktur per VBA
    festgelegt wird.
    Für andere Verwendungszwecke wäre jedoch die erste Variante zu favorisieren.



    so - ich geh mal weiter träumen :)
    danke nochmal matjes,
    nett das du dich gemeldet hast
    bye
    Senyavin
     
  9. was mir grade noch so ein/aufgefallen war:
    Kann man irgentrwie mit buttons arbeiten um die dateien über drag and droop zu verarbeiten?
    beispielsweise aus der mp3 tabelle die dateien gleich in die playlist schubsen?

    wenn nicht, auch egal!
    das ding is einfach auch so schon genial!
     
Die Seite wird geladen...

Automatisierung, Excel: Alle Dateien aus Ordner mit Hyperlink? - Ähnliche Themen

Forum Datum
Automatisierung: "bei zuklappen des laptops was machen..." Windows 8 Forum 17. Sep. 2014
Freeware Tool/Addin zur Backupautomatisierung? Windows XP Forum 10. Nov. 2004
Makro zur Automatisierung des Ausblendens von Leerzeilen? Microsoft Office Suite 1. Okt. 2004
automatisierung von scandisk, defrag, bereinigen Windows XP Forum 3. Feb. 2004
Automatisierungstool für Windows Windows XP Forum 3. Feb. 2004