VBA -UNC-PfadFAD-Hyperlink

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Micha,
Danke für die Blumen. Und, versuch's mal so.
Es wird - falls möglich - das Laufwerk 'übersetzt', der Pfad wird nur hinten ran kopiert.
HTH, Bernd
--
Option Explicit

Declare 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

   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 Test()
   Dim pfad$
   pfad = "p:\testXYZ"
   Debug.Print GetUNCPath(pfad)
   pfad = "C:\testXYZ"
   Debug.Print GetUNCPath(pfad)
End Sub

Sub Verknüpfung_senden() On Error Resume Next Dim Name As String Name = ActiveWorkbook.FullName Dim App, Itm Set App = CreateObject("Outlook.Application") Set Itm = App.CreateItem(0) With Itm .Subject = Name 'xxx hier muss das Ergebnis von GetUNCPath hin!!!! xxx .To = "" .Body = "ich habe obige Datei als Verknüpfung angehängt " .Attachments.Add Name, 4, , "Link" .Display End With Set App = Nothing Set Itm = Nothing End Sub

Hallo Micha,
Du brauchst die Funktion eigentlich nur auzurufen, also sowas:
.Subject = GetUNCPath( Name )
Du mußt eigentlich nur auf eines achten, die Funktion muß (wegen des declare) in ein
echtes Modul, nicht hinter eine Tabelle oder so.
Du solltest IMHO keinen "On Error Resume Next" benutzen, nimm besser sowas wie unten.
Übrigens, bei .Attachments.Add xyzName sollte es egal sein ob Du Name oder UNCName
benutzt, Outlook sollte hier selbständig einen UNC-Link daraus machen.
cu, Bernd
--
Option Explicit

Sub Verknüpfung_senden()
   Dim Name As String, UNCName As String
   Dim App As Object, Itm As Object

   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 obige Datei als Verknüpfung angehängt "
      .Attachments.Add Name, 4, , "Link"
      .Display
   End With
   Set App = Nothing
   Set Itm = Nothing
   myERR:
   If Err.Number <> 0 Then MsgBox "Fehler " & Err.Number & " : " & Err.Description
End Sub

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread