2 votes

Comment copier le chemin réseau du classeur ouvert dans Excel 2007 dans le presse-papiers ?

Je souhaite écrire une fonction VBA pour Excel 2007 (ainsi que Word 2007 et powerpoint 2007) qui :

  • copie le chemin réseau complet du classeur ou du fichier ouvert dans le presse-papiers.

Je travaille beaucoup avec des fichiers sur un lecteur réseau et le problème est que ma macro donne l'adresse avec la lettre du lecteur comme suit Z:\directory\myfile.xls au lieu de \\myservername\directory1\directory2\directory\myfile.xls

J'utilise le code suivant :

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

Je me demande donc s'il n'y aurait pas un moyen de "résoudre" la lettre de lecteur résultante en un chemin d'accès complet au réseau afin d'envoyer le chemin d'accès à d'autres utilisateurs qui ont des définitions de lettres de lecteur différentes.

J'ai trouvé une solution aquí Mais cela n'a pas fonctionné - j'obtiens un message d'erreur, il semble donc qu'il manque quelque chose ou que cela ne fonctionne tout simplement pas avec Excel 2007.

J'ai essayé d'invoquer le code Lettertounc("Z:") . L'erreur qui en résulte se produit à la ligne LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1) et il est dit (traduit) "les types ne sont pas compatibles".
La valeur de NetInfo(i).lpLocalName es 209899332 au moment de l'exécution.

Je travaille avec Windows 7 et Office 2007.

1voto

Giuseppe R Points 1325

Ajoutez ceci à votre code. Ensuite, tout ce que vous avez à faire est de prendre Left(strPfad, 2) qui devrait renvoyer quelque chose comme Z: et de le passer dans le DriveLetterToUNC et elle devrait renvoyer un chemin UNC comme \\server\mount .

Les déclarations et les constantes doivent être placées en tête du fichier. précéder ce texte dans votre code. Vous devriez être suffisamment capable d'appeler la fonction DriveLetterToUNC() pour obtenir l'information dont vous avez besoin et l'insérer dans votre chaîne de caractères.

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

SistemesEz.com

SystemesEZ est une communauté de sysadmins où vous pouvez résoudre vos problèmes et vos doutes. Vous pouvez consulter les questions des autres sysadmins, poser vos propres questions ou résoudre celles des autres.

Powered by:

X