2

我有这个最初只由我使用的宏。但我现在需要把它分发给其他人。基本上，我写了一个宏，让你浏览文件，然后它将我的本地路径转换为网络驱动器路径（HTML 样式）。从我下面的代码可以看出，我特指的是 R 盘和 Z 盘。但是，如果其他人使用它，他们可以用 A 驱动器和 B 驱动器代替。如何重写以下内容，以便拉网络驱动器而不是本地驱动器？谢谢！

Private Sub GetFilePath_Click()

FilePath = Application.GetOpenFilename()
If FilePath <> False Then
    Range("E6").Value = FilePath
End If

End Sub

将选择的文件转换为 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
4

3 回答 3

0

在做了一些研究之后，我实际上回答了我自己的问题。下面是代码供有兴趣的人参考。以下代码在最终用户导入其文件时获取 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

下面的函数将导入文件的文件路径转换为 ​​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
于 2013-08-12T15:50:38.360 回答
0

就个人而言，我会添加 Inputbox 让 ppl 键入他们的驱动器，并将给定的值与路径的其余部分连接起来。

于 2013-08-09T10:21:11.373 回答
0

复制自http://support.microsoft.com/kb/160529

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

微软 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
于 2014-04-01T14:42:36.007 回答