Как скопировать сетевой путь открытой рабочей книги в Excel 2007 в буфер обмена?

Question

Я хочу написать функцию VBA для Excel 2007 (а также Word 2007 и PowerPoint 2007), которая:

• копирует полный сетевой путь открытой книги или файла в буфер обмена.

Я много работаю с файлами на сетевом диске, и проблема в том, что мой макрос затем выдает адрес с буквой диска, такой как Z:\directory\myfile.xls вместо \\myservername\directory1\directory2\directory\myfile.xls

Я использую следующий код:

Sub CopyPathToClipboard()
Dim strPfad As String
Dim mText As DataObject
Set mText = New DataObject

strPfad = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
mText.SetText strPfad
mText.PutInClipboard

End Sub

Поэтому мне интересно, может ли быть способ "преобразовать" полученную букву диска в полный сетевой путь, чтобы дать возможность отправить путь другим пользователям, которые имеют разные определения букв дисков.

Я нашел решение здесь, но оно не сработало - я получаю сообщение об ошибке, поэтому, кажется, что-то отсутствует или оно просто не работает в Excel 2007.

Я пытался вызвать код Lettertounc("Z:") . Возникающая ошибка возникает в строке LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1) и говорит (переведено) "типы несовместимы".
Значение NetInfo(i).lpLocalName равно 209899332 во время выполнения.

Я работаю с Windows 7 и Office 2007.

Answer 1

Добавьте это в свой код. Затем все, что вам нужно сделать, это взять Left(strPfad, 2) , который должен вернуть что-то вроде Z: и передать его в функцию DriveLetterToUNC , и он должен вернуть UNC-путь, такой как \\server\mount .

Декларации и константы должны находиться в верхней части файла, поэтому добавьте этот текст к своему коду. Вы должны быть достаточно способны вызывать DriveLetterToUNC() чтобы получить необходимую информацию и вставить ее в строку.

Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_CONNECTED = &H1
Private Type NETRESOURCE
   dwScope As Long
   dwType As Long
   dwDisplayType As Long
   dwUsage As Long
   lpLocalName As Long
   lpRemoteName As Long
   lpComment As Long
   lpProvider As Long
End Type
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias _
   "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, _
   ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) _
   As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias _
   "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, _
   lpBuffer As Any, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" ( _
   ByVal hEnum As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
   (ByVal lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
   (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

Public Function DriveLetterToUNC(Optional DriveLetter As String = "C:") As String
   'converts a given drive letter to the mapped UNC of the local machine
   'eg DriveLetterToUNC("F:")
   '  returns "\\servername\drivename"
   '  or "F:" if not found

   Dim hEnum As Long
   Dim NetInfo(1023) As NETRESOURCE
   Dim entries As Long
   Dim nStatus As Long
   Dim LocalName As String
   Dim UNCName As String
   Dim i As Long
   Dim r As Long

   ' Begin the enumeration
   nStatus = WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, _
      0&, ByVal 0&, hEnum)

   DriveLetterToUNC = DriveLetter

   'Check for success from open enum
   If ((nStatus = 0) And (hEnum <> 0)) Then
      ' Set number of entries
      entries = 1024

      ' Enumerate the resource
      nStatus = WNetEnumResource(hEnum, entries, NetInfo(0), _
         CLng(Len(NetInfo(0))) * 1024)

      ' Check for success
      If nStatus = 0 Then
         For i = 0 To entries - 1
            ' Get the local name
            LocalName = ""
            If NetInfo(i).lpLocalName <> 0 Then
               LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1)
               r = lstrcpy(LocalName, NetInfo(i).lpLocalName)
            End If

            ' Strip null character from end
            If Len(LocalName) <> 0 Then
               LocalName = Left(LocalName, (Len(LocalName) - 1))
            End If

            If UCase$(LocalName) = UCase$(DriveLetter) Then
               ' Get the remote name
               UNCName = ""
               If NetInfo(i).lpRemoteName <> 0 Then
                  UNCName = Space(lstrlen(NetInfo(i).lpRemoteName) + 1)
                  r = lstrcpy(UNCName, NetInfo(i).lpRemoteName)
               End If

               ' Strip null character from end
               If Len(UNCName) <> 0 Then
                  UNCName = Left(UNCName, (Len(UNCName) - 1))
               End If

               ' Return the UNC path to drive
               DriveLetterToUNC = Trim(UNCName)

               ' Exit the loop
               Exit For
            End If
         Next i
      End If
   End If

   ' End enumeration
   nStatus = WNetCloseEnum(hEnum)
End Function