Làm cách nào để sao chép đường dẫn mạng của sổ làm việc đang mở trong Excel 2007 vào bảng tạm?

Tôi muốn viết một hàm VBA cho Excel 2007 (cũng như Word 2007 và powerpoint 2007):

sao chép đường dẫn mạng hoàn chỉnh của sổ làm việc hoặc tệp vào bảng tạm.

Tôi đang làm việc rất nhiều với các tệp trên ổ đĩa mạng và vấn đề là, macro của tôi sau đó đưa ra địa chỉ với ký tự ổ đĩa như Z:\directory\myfile.xlsthay vì\\myservername\directory1\directory2\directory\myfile.xls

Tôi đang sử dụng mã sau đây:

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

Vì vậy, tôi tự hỏi liệu có cách nào để "giải quyết" ký tự ổ đĩa kết quả đến đường dẫn mạng hoàn chỉnh để gửi đường dẫn đến những người dùng khác có định nghĩa ký tự ổ đĩa khác nhau.

Tôi đã tìm thấy một giải pháp ở đây , nhưng nó không hoạt động - Tôi nhận được một thông báo lỗi, vì vậy dường như thiếu một cái gì đó hoặc nó không hoạt động trong Excel 2007.

Tôi đã cố gắng để gọi mã Lettertounc("Z:"). Lỗi kết quả xảy ra trong dòng LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1)và nó nói (dịch) "các loại không tương thích".
Giá trị của NetInfo(i).lpLocalNamelà 209899332trong thời gian chạy.

Tôi đang làm việc với Windows 7 và Office 2007.

— Hầu như không có gì
nguồn

Cung cấp chi tiết về thông báo lỗi bạn nhận được, nếu bạn muốn trợ giúp với phương pháp đó

— allquixotic

@allquixotic Tôi đã thêm mô tả lỗi

— Chủ yếu là không có

Thêm mã này vào mã của bạn. Sau đó, tất cả những gì bạn phải làm là lấy Left(strPfad, 2), cái này sẽ trả về một cái gì đó giống như Z:, và chuyển nó vào DriveLetterToUNChàm, và nó sẽ trả về một đường dẫn UNC như thế nào \\server\mount.

Các khai báo và hằng số phải ở đầu tệp, vì vậy hãy thêm văn bản này vào mã của bạn. Bạn cần có đủ khả năng gọi DriveLetterToUNC()hàm để lấy thông tin bạn cần và chèn nó vào chuỗi của bạn.

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

— allquixotic
nguồn