Como copiar o caminho de rede da pasta de trabalho aberta no Excel 2007 para a área de transferência?

Question

Eu quero escrever uma função VBA para o Excel 2007 (assim como o Word 2007 e o powerpoint 2007) que:

• copia o caminho completo da rede da pasta de trabalho ou arquivo aberto para a área de transferência.

Estou trabalhando muito com arquivos em uma unidade de rede e o problema é que minha macro fornece o endereço com a letra da unidade como Z:\directory\myfile.xls em vez de \myservername\directory1\directory2\directory\myfile.xls

Estou usando o seguinte código:

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

Então, pergunto-me se poderia haver uma maneira de "resolver" a letra da unidade resultante para o caminho de rede completo para dar o caminho para outros usuários que têm definições de letra de unidade diferentes.

Encontrei uma solução aqui , mas não funcionou Estou recebendo uma mensagem de erro, por isso parece estar faltando alguma coisa ou simplesmente não funciona com o Excel 2007.

Eu tentei invocar o código Lettertounc("Z:") . O erro resultante ocorre na linha LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1) e diz (traduzido) "tipos não são compatíveis". O valor de NetInfo(i).lpLocalName é 209899332 no tempo de execução.

Estou trabalhando com o Windows 7 e o Office 2007.

    

Answer 1

Adicione isto ao seu código. Então, tudo que você precisa fazer é usar Left(strPfad, 2) , que deve retornar algo como Z: , e passá-lo para a função DriveLetterToUNC , e ele deve retornar um caminho UNC como \server\mount .

A declaração e as constantes devem estar no topo do arquivo, então prefixar este texto ao seu código. Você deve ser capaz de chamar a função DriveLetterToUNC() para obter as informações necessárias e inseri-las na sua string.

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