☰

如何将Excel 2007中打开的工作簿的网络路径复制到剪贴板？

tag-icon • tag-icon microsoft-excel-2007 path microsoft-office-2007 vba
如何将Excel 2007中打开的工作簿的网络路径复制到剪贴板？

我想为 Excel 2007（以及 Word 2007 和 powerpoint 2007）编写一个 VBA 函数，它：

  • 将打开的工作簿或文件的完整网络路径复制到剪贴板。

我经常处理网络驱动器上的文件，问题是，我的宏会给出驱动器号的地址，而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).lpLocalName209899332

我正在使用 Windows 7 和 Office 2007。

答案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

相关内容