将共享文件夹路径转换为UNC路径

我正在尝试通过使用计算机名称操作当前路径将当前共享文件夹路径转换为unc路径.但是导致编译错误:公共函数UNCpath()中"elem = UBound(CurrentPathA)"行上的预期数组.你们能告诉我导致这个问题的问题吗？也许分享更好的想法来获得路径？

    Option Explicit

    #If VBA7 Then
    Private Declare PtrSafe Function fnGetComputerName Lib "kernel32" Alias "GetComputerNameW" (ByVal lpBuffer As LongPtr, ByRef nSize As Long) As Long
    #Else
    Private Declare Function fnGetComputerName Lib "kernel32" Alias "GetComputerNameW" (ByVal lpBuffer As Long, ByRef nSize As Long) As Long
    #End If

    Public Function GetComputerName() As String
    Const MAX_COMPUTERNAME_LENGTH As LOng= 31

    Dim buf As String, buf_len As Long

    buf = String$(MAX_COMPUTERNAME_LENGTH + 1, 0)
    buf_len = Len(buf)

    If (fnGetComputerName(StrPtr(buf), buf_len)) = 0 Then
    GetComputerName = "ErrorGettingComputerName"
    Else
    GetComputerName = Left$(buf, buf_len)
    End If
    End Function


    Public Function UNCpath() As String
    Dim CompName As String, CurrentPath As String, CurrentPathA As String

    CompName = GetComputerName()
    CurrentPath = ThisWorkbook.Path
    CurrentPathA = Split(CurrentPath, "\")
    elem = UBound(CurrentPathA)
    CurrentPath = CurrentPathA(elem)
    UNCpath = "\\" & CompName & "\" & CurrentPath
    End Function

Steve Rindsb.. 6

或者使用文件系统对象:

Function GetUNCLateBound(strMappedDrive As String) As String

    Dim objFso  As Object
    Set objFso = CreateObject("Scripting.FileSystemObject")

    Dim strDrive As String
    Dim strShare As String

    'Separate the mapped letter from
    'any following sub-folders
    strDrive = objFso.GetDriveName(strMappedDrive)

    'find the UNC share name from the mapped letter
    strShare = objFso.Drives(strDrive & "\").ShareName

    'The Replace function allows for sub-folders
    'of the mapped drive
    GetUNCLateBound = Replace(strMappedDrive, strDrive, strShare)

    Set objFso = Nothing 'Destroy the object

End Function

我刚刚找到并修改了这个信用额度到期的时间:

http://pagecommunication.co.uk/2014/07/vba-to-convert-a-mapped-drive-letter-to-unc-path/

或者使用文件系统对象:

Function GetUNCLateBound(strMappedDrive As String) As String

    Dim objFso  As Object
    Set objFso = CreateObject("Scripting.FileSystemObject")

    Dim strDrive As String
    Dim strShare As String

    'Separate the mapped letter from
    'any following sub-folders
    strDrive = objFso.GetDriveName(strMappedDrive)

    'find the UNC share name from the mapped letter
    strShare = objFso.Drives(strDrive & "\").ShareName

    'The Replace function allows for sub-folders
    'of the mapped drive
    GetUNCLateBound = Replace(strMappedDrive, strDrive, strShare)

    Set objFso = Nothing 'Destroy the object

End Function

我刚刚找到并修改了这个信用额度到期的时间:

http://pagecommunication.co.uk/2014/07/vba-to-convert-a-mapped-drive-letter-to-unc-path/