Gruppe
Link
Problem
Ein über GetOpenFileName ermittelter Dateiname soll in Zelle A2 mit dem Arbeitsblattnamen in Zelle B2 und der Zelladresse in C2 zu einer Verknüpfung verbunden werden.
StandardModule: Modul1
Sub CreateLink()
Dim vFile As Variant
Dim sPath As String, sWkb As String, sWks As String, sRng As String
vFile = Application.GetOpenFilename("Excel-Dateien (*.xls), *.xls")
If vFile = False Then Exit Sub
sWks = Range("B2").Value
sRng = Range("C2").Value
sPath = fctPathName(CStr(vFile))
sWkb = fctFileName(CStr(vFile))
vFile = "'" & sPath & "[" & sWkb & "]" & sWks & "'!" & sRng
Range("A2").Formula = "=" & vFile
End Sub
Private Function fctPathName(sFile As String)
Dim iCounter As Integer
Dim sTmp As String
sTmp = sFile
Do While InStr(sTmp, "\")
sTmp = Right(sTmp, Len(sTmp) - 1)
iCounter = iCounter + 1
Loop
fctPathName = Left(sFile, iCounter)
End Function
Private Function fctFileName(sFile As String)
Dim iCounter As Integer
For iCounter = Len(sFile) To 1 Step -1
If Mid(sFile, iCounter, 1) = "\" Then Exit For
Next iCounter
fctFileName = Right(sFile, Len(sFile) - iCounter)
End Function