VBA：从本地驱动器名称转换为网络驱动器名称
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18129708/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA: Convert from local drive name to network drive name
提问by Futochan
I have this macro that initially only used by me. But I need to distribute it to other people now. Basically, I wrote a macro that let you browse for file, and then it will convert my local path into network drive path (HTML style). As you can see from my code below, I am specifically referring to R drive and Z drive. However, if other people use it, they could have A drive and B drive instead. How do I rewrite the following such that, it will pull the network drive instead of local drive? Thanks!
我有这个最初只供我使用的宏。但我现在需要把它分发给其他人。基本上，我写了一个宏，让你浏览文件，然后它将我的本地路径转换为网络驱动器路径（HTML 样式）。从我下面的代码可以看出，我特指的是 R 盘和 Z 盘。但是，如果其他人使用它，他们可以用 A 驱动器和 B 驱动器代替。如何重写以下内容，以便它会拉取网络驱动器而不是本地驱动器？谢谢！
Private Sub GetFilePath_Click()
FilePath = Application.GetOpenFilename()
If FilePath <> False Then
Range("E6").Value = FilePath
End If
End Sub
A function that convert the file that selected into HTML path
将选择的文件转换为 HTML 路径的函数
Function ModFilePath(FilePath As String) As String
Dim HTMLFilePath As String
Dim Drive1 As String
Dim Drive2 As String
Dim Drive3 As String
On Error Resume Next
HTMLFilePath = Replace(FilePath, " ", "%20")
'I know somehow I need to rewrite this part
Drive1 = Replace(HTMLFilePath, "R:\", "\network_name\apple\")
Drive2 = Replace(HTMLFilePath, "Z:\", "\network_name\orange\")
If Err.Number = 0 Then
If Left(HTMLFilePath, 1) = "R" Then
ModFilePath = Drive1
Else
If Left(HTMLFilePath, 1) = "Z" Then
ModFilePath = Drive2
End If
End If
Else
ModFilePath = "Error"
End If
End Function
采纳答案by Futochan
After doing some research, I actually answered my own question. Here is the code for those who are interested. The following code gets the UNC path instead of the network share drive letter when the end users import their file:
在做了一些研究之后，我实际上回答了我自己的问题。有兴趣的朋友可以看看代码。当最终用户导入他们的文件时，以下代码获取 UNC 路径而不是网络共享驱动器号：
Option Explicit
Private Declare Function SetCurrentDirectory _
Lib "kernel32" _
Alias "SetCurrentDirectoryA" ( _
ByVal lpPathName As String) _
As Long
Public Sub GetFilePath_Click()
Dim vFileToOpen As Variant
Dim strCurDir As String
Dim WikiName As String
'// Keep Original Dir
strCurDir = CurDir
'// Note: If the UNC path does not exist then
'// It will default to your current one
SetCurrentDirectory "\network_name\"
vFileToOpen = Application.GetOpenFilename
If TypeName(vFileToOpen) <> "Boolean" Then
Range("E6").Value = vFileToOpen
End If
'// End by resetting to last/original Dir
ChDir strCurDir
End Sub
The function below convert the file path that the imported file to HTML style.
下面的函数将导入文件的文件路径转换为 HTML 样式。
Function Path2UNC(sFullName As String) As String
' Converts the mapped drive path in sFullName to a UNC path if one exists.
' If not, returns a null string
Dim sDrive As String
Dim i As Long
Dim ModDrive1 As String
Application.Volatile
sDrive = UCase(Left(sFullName, 2))
With CreateObject("WScript.Network").EnumNetworkDrives
For i = 0 To .Count - 1 Step 2
If .Item(i) = sDrive Then
Path2UNC = .Item(i + 1) & Mid(sFullName, 3)
Exit For
End If
Next
End With
ModDrive1 = Replace(Path2UNC, " ", "%20")
Path2UNC = ModDrive1
End Function
回答by lowak
Personally, I would add Inputbox to let ppl type their drive and the value given concatenated with rest of the path.
就个人而言，我会添加 Inputbox 让 ppl 输入他们的驱动器，并将给定的值与路径的其余部分连接起来。
回答by bubbassauro
Copied from http://support.microsoft.com/kb/160529
复制自http://support.microsoft.com/kb/160529
Microsoft Office 97 and Microsoft Office 7.0
Microsoft Office 97 和 Microsoft Office 7.0
' 32-bit Function version.
' Enter this declaration on a single line.
Declare Function WNetGetConnection32 Lib "MPR.DLL" Alias _
"WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal _
lpszRemoteName As String, lSize As Long) As Long
' 32-bit declarations:
Dim lpszRemoteName As String
Dim lSize As Long
' Use for the return value of WNetGetConnection() API.
Const NO_ERROR As Long = 0
' The size used for the string buffer. Adjust this if you
' need a larger buffer.
Const lBUFFER_SIZE As Long = 255
Sub GetNetPath()
' Prompt the user to type the mapped drive letter.
DriveLetter = UCase(InputBox("Enter Drive Letter of Your Network" & _
"Connection." & Chr(10) & "i.e. F (do not enter a colon)"))
' Add a colon to the drive letter entered.
DriveLetter = DriveLetter & ":"
' Specifies the size in characters of the buffer.
cbRemoteName = lBUFFER_SIZE
' Prepare a string variable by padding spaces.
lpszRemoteName = lpszRemoteName & Space(lBUFFER_SIZE)
' Return the UNC path (\Server\Share).
lStatus& = WNetGetConnection32(DriveLetter, lpszRemoteName, _
cbRemoteName)
' Verify that the WNetGetConnection() succeeded. WNetGetConnection()
' returns 0 (NO_ERROR) if it successfully retrieves the UNC path.
If lStatus& = NO_ERROR Then
' Display the UNC path.
MsgBox lpszRemoteName, vbInformation
Else
' Unable to obtain the UNC path.
MsgBox "Unable to obtain the UNC path.", vbInformation
End If
End Sub
Microsoft Excel 5.0
微软 Excel 5.0
' 16-bit Function for Excel 5.0. ' Enter this declaration on a single line. Declare Function WNetGetConnection Lib "user" (ByVal lpszLocalName _
As String, ByVal lpszRemoteName As String, cbRemoteName As _
Integer) As Integer
' 16-bit declarations: Dim NetName As String Dim x As Integer Dim DriveLetter As String
Sub GetNetPath()
' Prompt the user to type the mapped drive letter.
DriveLetter = UCase(InputBox("Enter Drive Letter of Your Network" & _
"Connection." & Chr(10) & "i.e. F (do not enter a colon)"))
DriveLetter = DriveLetter & ":"
' 16-bit call for Excel 5.0.
' Pad NetName with spaces.
NetName = NetName & Space(80)
' API call returns one of eight values. If it returns zero, it is
' successful.
x = WNetGetConnection(DriveLetter, NetName, 80)
' Display the UNC path.
MsgBox NetName
End Sub
