per Makro Hyperlinks zu Dateien erstellen

Question

Guten Tag,

ich bekomme Excel Listen in denen eine Spalte mit Nummern versehen ist. Diese
Nummern entsprechen Ordnernamen. In jedem dieser Ordner liegt genau 1 Datei.
Ich würde gerne automatisch alle Nummern in der Spalte zu Hyperlinks umwandeln,
die dann die jeweilige Datei öffnen.
Die o.g. Ordner befinden sich alle an einem Speicherort und sind nicht weiter
verschachtelt oder so. Am besten, falls das überhaupt möglich ist, fragt das Makro nach
diesem Speicherort.
Ich hoffe mir kann jemand helfen, ich habe leider keine Ahnung von VBA.

Vielen Dank im Voraus

Answer 1

Hallo,

das folgende Makro gehört in ein Standard Modul deiner Arbeitsmappe:

Sub hyperlinks_erstellen()

Dim lngLetzte As Long
Dim lngZeile As Long
Dim strPfad As String
Dim strPfadHyp As String
Dim strDatei As String
Dim AppShell As Object
Dim BrowseDir As Variant

'letzte Zeile in Spalte A ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

'Pfad auswählen, in dem die Unterverzeichnisse liegen
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
On Error Resume Next
strPfad = BrowseDir.items().Item().Path
If strPfad = "" Then
MsgBox "Es wurde kein gültiger Pfad ausgewählt! Abbruch!", 16, "Fehler"
Exit Sub
End If

'nun Zeilen durchlaufen und Unterverzeichnis erstellen
'ab Zeile 2 in Spalte A
For lngZeile = 2 To lngLetzte
strPfadHyp = strPfad & "\" & Cells(lngZeile, "A").Value & "\"
'Datei aus Unterverzeichnis einlesen
strDatei = Dir(strPfadHyp & "*.*")
'Hyperlink in Spalte A einfügen
With ActiveSheet
.Hyperlinks.Add anchor:=.Cells(lngZeile, "A"), _
Address:=strPfadHyp & strDatei
End With

Next lngZeile

End Sub

Hier stehen die Unterverzeichnisse in Spalte A. Das musst du natürlich auf deine Verhältnisse anpassen. Ersetze einfach die A in den Hochkommas durch deine Spalte.

Gruß

M.O.