@BST - noch ne Frage

Function WNetGetConnection32 Lib "MPR.DLL" Alias _
"WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal _
lpszRemoteName As String, lSize As Long) As Long

Function GetUNCPath(Pathname As String) As String
Dim UNCPath As String, lw As String, pfad As String
Dim Names As String
GetUNCPath = Pathname
If Len(Pathname) > 1 Then
lw = Left(Pathname, 2)
If lw Like "[A-Za-z]:" Then
pfad = Mid(Pathname, 3)
UNCPath = String(256, 0)
If WNetGetConnection32(lw, UNCPath, 256) = 0 Then
GetUNCPath = Left(UNCPath, InStr(1, UNCPath, Chr(0)) - 1) & pfad
End If
End If
End If
End Function



Sub Hyperlink_senden()
Dim Name As String, UNCName As String
Dim App As Object, Itm As Object
Dim Username As String
On Error GoTo myERR
Name = ActiveWorkbook.FullName
UNCName = GetUNCPath(Name)
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
With Itm
.Subject = UNCName
.To = ""
.body = "ich habe unten folgende Datei als Hyperlink angehängt!" & Chr(13) & Chr(13) & "Mit freundlichen Grüßen" & Chr(13) & "Mein Name" & Chr(13) & Chr(13) & UNCName
'.Attachments.Add Name, 3
.Display
End With
Set App = Nothing
Set Itm = Nothing
myERR:
If Err.Number <> 0 Then MsgBox "Fehler " & Err.Number & " : " & Err.Description
End Sub


*************************************************************************

Nochmals vielen Dank für deine Mühen!

Gruss

Micha