PDA

Vollständige Version anzeigen : Hyperlink


MickeyZ
04.06.2012, 19:42
Hallo zusammen,

ich habe in meinem Eingabeformular einen Button über den ich einen Hyperlink in mein Formular einfügen kann. Allerdings werden dort feste Pfandangaben gemacht wie z.B. f:\test. Kann ich hier auch die URL anzeigen lassen? Also z.B. \\holmfs01\test?

Der Befehl hinter dem Einfügebutton ist folgendermaßen aufgebaut:

Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String

OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = Me.Hwnd
OpenFile.hInstance = 0
'Dateifilter: Jede Zeile besteht aus Beschreibung und Wildcard,
'Trennung dazwischen und zwischen den Zeilen mit Chr(0)
sFilter = "Excel-Dateien (*.xls)" & Chr(0) & "*.XLS" & Chr(0) & _
"Alle Dateien (*.*)" & Chr(0) & "*.*" & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 2 'Erste Filterauswahl
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = "Bitte Datei auswählen"
OpenFile.flags = &H800
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
' Cancel gedrückt
Else
Dim fileName As String
Dim fileNameLength As Integer

fileName = Trim(OpenFile.lpstrFile)
fileNameLength = InStr(fileName, Chr(0))
fileName = Left(fileName, fileNameLength - 1)

Dim linkString As String
linkString = "Link to: " & fileName & "#" & fileName & "##helptext"
Me.Link = linkString

'Beispielcode für Tests ........
Dim hyper As Hyperlink
Set hyper = Me.Link.Hyperlink

Debug.Print hyper.Address
'Debug.Print hyper.EmailSubject
Debug.Print hyper.ScreenTip
Debug.Print hyper.SubAddress
Debug.Print hyper.TextToDisplay

Debug.Print HyperlinkPart(Me.Link, acAddress)
'..........Beispielcode für Tests

End If

End Sub

Danke im voraus
Mickey

MickeyZ
04.06.2012, 19:43
ich meinte UNC-Pfad...

Lanz Rudolf
04.06.2012, 20:00
Hallo
hilft Das:

Aus UncPfad den Disk holen mit
DrivePath
Beispiel:
DrivePath("\\pc1\daten_pc1\") gibt Z:\
Mit dem Disk den UNC Pfad Bestimmen
UNCPath
Beispiel:
UNCPath("Z:\") gibt pc daten_pc1\

Code:
Private Declare Function WNetGetConnectionA Lib "mpr.dll" ( _
ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
cbRemoteName As Long) As Long
Private Declare Function GetLogicalDriveStringsA Lib "kernel32" ( _
ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Function LogicalDrives() As Collection
Dim s As String * 128
Dim i As Long
'API aufrufen:
GetLogicalDriveStringsA Len(s), s
i = InStr(s, vbNullChar & vbNullChar) 'Länge
'Collection füllen:
Set LogicalDrives = New Collection
For i = 1 To i Step 4
LogicalDrives.Add Mid$(s, i, 2)
Next i
End Function
Public Function DrivePath(ByVal Path As String, _
Optional IgnoreErrors As Boolean = False) As String
'Aufruf: ?DrivePath("\\pc1\daten_pc1\") --> Z:\
Dim Drive As Variant
Dim UNC As String
'Alle Laufwerke durchsuchen:
If Right$(Path, 1) <> "\" Then Path = Path & "\"
For Each Drive In LogicalDrives()
UNC = UNCPath(Drive, True)
If InStr(1, Path, UNC, vbTextCompare) = 1 Then Exit For
Next Drive
If IsEmpty(Drive) Then
'Kein Laufwerk für UNC gefunden:
If IgnoreErrors Then
DrivePath = Path
Else
Err.Raise 5 'Invalid procedure call or argument
End If
Else
'Ergebnis zurückgeben:
DrivePath = Drive & Mid$(Path, Len(UNC))
End If
End Function
Public Function UNCPath(ByVal Path As String, _
Optional IgnoreErrors As Boolean = False) As String
'Aufruf: ?UNCPath("Z:\") --> \\pc1\daten_pc1\ (oder nur Z: oder Z
Dim UNC As String * 512
If Len(Path) = 1 Then Path = Path & ":"
If Right$(Path, 1) <> "\" Then Path = Path & "\"
If WNetGetConnectionA(Left$(Path, 2), UNC, Len(UNC)) Then
'API-Routine gibt Fehler zurück:
If IgnoreErrors Then
UNCPath = Path
Else
Err.Raise 5 'Invalid procedure call or argument
End If
Else
'Ergebnis zurückgeben:
UNCPath = Left$(UNC, InStr(UNC, vbNullChar) - 1) _
& Mid$(Path, 3)
End If
End Function

Lanz Rudolf
04.06.2012, 20:01
Hallo
hilft Das:

Aus UncPfad den Disk holen mit
DrivePath
Beispiel:
DrivePath("\\pc1\daten_pc1\") gibt Z:\
Mit dem Disk den UNC Pfad Bestimmen
UNCPath
Beispiel:
UNCPath("Z:\") gibt pc daten_pc1\

Code:
Private Declare Function WNetGetConnectionA Lib "mpr.dll" ( _
ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
cbRemoteName As Long) As Long
Private Declare Function GetLogicalDriveStringsA Lib "kernel32" ( _
ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Function LogicalDrives() As Collection
Dim s As String * 128
Dim i As Long
'API aufrufen:
GetLogicalDriveStringsA Len(s), s
i = InStr(s, vbNullChar & vbNullChar) 'Länge
'Collection füllen:
Set LogicalDrives = New Collection
For i = 1 To i Step 4
LogicalDrives.Add Mid$(s, i, 2)
Next i
End Function
Public Function DrivePath(ByVal Path As String, _
Optional IgnoreErrors As Boolean = False) As String
'Aufruf: ?DrivePath("\\pc1\daten_pc1\") --> Z:\
Dim Drive As Variant
Dim UNC As String
'Alle Laufwerke durchsuchen:
If Right$(Path, 1) <> "\" Then Path = Path & "\"
For Each Drive In LogicalDrives()
UNC = UNCPath(Drive, True)
If InStr(1, Path, UNC, vbTextCompare) = 1 Then Exit For
Next Drive
If IsEmpty(Drive) Then
'Kein Laufwerk für UNC gefunden:
If IgnoreErrors Then
DrivePath = Path
Else
Err.Raise 5 'Invalid procedure call or argument
End If
Else
'Ergebnis zurückgeben:
DrivePath = Drive & Mid$(Path, Len(UNC))
End If
End Function
Public Function UNCPath(ByVal Path As String, _
Optional IgnoreErrors As Boolean = False) As String
'Aufruf: ?UNCPath("Z:\") --> \\pc1\daten_pc1\ (oder nur Z: oder Z
Dim UNC As String * 512
If Len(Path) = 1 Then Path = Path & ":"
If Right$(Path, 1) <> "\" Then Path = Path & "\"
If WNetGetConnectionA(Left$(Path, 2), UNC, Len(UNC)) Then
'API-Routine gibt Fehler zurück:
If IgnoreErrors Then
UNCPath = Path
Else
Err.Raise 5 'Invalid procedure call or argument
End If
Else
'Ergebnis zurückgeben:
UNCPath = Left$(UNC, InStr(UNC, vbNullChar) - 1) _
& Mid$(Path, 3)
End If
End Function

Sorry es ist nicht sauber Formatiert :(