반응형
OneDrive를 통한 Excel의 풀네임 속성
열린 워크북 개체를 사용하여 Excel 파일을 저장한 후 전체 이름을 가져오려고 하는데 해당 파일이 OneDrive에 동기화되어 있으면 로컬 주소가 아닌 "https" 주소가 표시되며, 이 주소는 다른 프로그램에서 해석할 수 없습니다.
이런 파일의 로컬 파일 이름을 얻으려면 어떻게 해야 하나요?
§:
을 「에 보존합니다.\Users\user\OneDrive - Company\Documents"를 참조하십시오.
OneDrive 。
이치노 Full 은 ""Full Name" "https://..."으로 됩니다.
유니버설 솔루션 및 모든 솔루션의 메타 분석
TLDR:
솔루션에 대해서는 "솔루션" 섹션으로 건너뜁니다.
메타 분석의 경우 솔루션 테스트 및 비교 섹션으로 건너뜁니다.
배경
지난 몇 달 동안 @Cristian Buse(GitHub)와 저는 해당 문제에 대한 광범위한 연구와 작업을 수행했고, 그 결과 이전에 사용 가능한 솔루션으로는 해결할 수 없었던 수많은 사례를 발견하게 되었습니다.이 때문에, 우리는 독자적인 솔루션을 개량하기 시작했습니다.
안타깝게도 개발 과정 내내 NAT 솔루션은 매우 복잡해졌습니다.이러한 기능의 정확한 설명은 단일 StackOverflow 응답의 범위를 훨씬 넘어섭니다.
이러한 기술에 관심이 있는 분들을 위해 진행 상황에 대해 논의하는 데 사용한 스레드에 대한 링크를 다음에 제시하겠습니다.스레드 1, 스레드 2이 스레드의 총 볼륨은 약 40,000단어 또는 150페이지입니다.다행히도, 우리의 노력의 결실을 거두기 위해 그 중 어느 것도 이해할 필요가 없다.
결국, 양사 모두 독자적인 솔루션을 개발했습니다.
@중 @Cristian Buse VBA Library, Library @Cristian Buse입니다.
VBA-FileTools이 기능은 우아하게 구현되어 있으며, 이 코드를 통해 솔루션의 구조를 상세하게 파악할 수 있는 가장 좋은 방법입니다.게다가, 그의 라이브러리는 다른 많은 매우 유용한 기능들을 제공합니다.저만의 솔루션은 종속성이 없는 독립형 기능의 형태로 제공됩니다.이는 추가 기능이 필요하지 않은 소규모 프로젝트에서 이 문제가 발생할 경우 유용합니다.원하는 범용 기능의 구현은 복잡하기 때문에 단일 절차로 매우 길고 복잡합니다.이 함수의 코드를 읽고 해결책을 이해하는 것은 권장하지 않습니다.
현재(2023년 1월 27일) macOS에서도 이 문제를 해결할 수 있는 유일한 방법입니다!
솔루션
메모: 델의 솔루션에서 버그가 발생했을 경우는, 이쪽이나 GitHub로 보고해 주세요.이 경우 이 솔루션을 사용하는 것이 가장 정확한 솔루션이기 때문에 그 사이에 사용하는 것이 좋습니다.
해결책 1 - 라이브러리(현재는 Windows만)
이 라이브러리: VBA-FileTools를 GitHub에서 프로젝트로 Import합니다.그러면 워크북의 로컬 이름을 쉽게 얻을 수 있습니다.
GetLocalPath(ThisWorkbook.FullName)
솔루션 2 - 스탠드아론 기능(Windows 및 MacOS에서 작동)
GitHub Gist에서 또는 이 답변에서 직접 이 함수를 표준 코드 모듈에 복사합니다.GitHub Gist 버전에는 코드에 추가 정보와 코멘트가 포함되어 있습니다.
이제 워크북의 로컬 이름을 얻는 방법은 솔루션 1과 같습니다.
GetLocalPath(ThisWorkbook.FullName)
이 함수는 일부 옵션 파라미터도 제공하지만 거의 필요하지 않습니다.(자세한 내용은 Gist 참조)
MacOS를 사용하는 경우 현재 이 솔루션만 사용할 수 있습니다.이 게시물에서 분석한 다른 모든 솔루션은 MacOS에서 전혀 작동하지 않습니다.
다음은 함수의 코드입니다.
'This Function will convert a OneDrive/SharePoint Url path, e.g. Url containing
'https://d.docs.live.net/; .sharepoint.com/sites; my.sharepoint.com/personal/...
'to the locally synchronized path on your current pc or mac, e.g. a path like
'C:\users\username\OneDrive\ on Windows; or /Users/username/OneDrive/ on MacOS,
'if you have the remote directory locally synchronized with the OneDrive app.
'If no local path can be found, the input value will be returned unmodified.
'Author: Guido Witt-Dörring
'Source: https://gist.github.com/guwidoe/038398b6be1b16c458365716a921814d
Public Function GetLocalPath(ByVal path As String, _
Optional ByVal rebuildCache As Boolean = False, _
Optional ByVal returnAll As Boolean = False, _
Optional ByVal preferredMountPointOwner As String = "") _
As String
#If Mac Then
Const vbErrPermissionDenied As Long = 70
Const vbErrInvalidFormatInResourceFile As Long = 325
Const ps As String = "/"
#Else
Const ps As String = "\"
#End If
Const vbErrFileNotFound As Long = 53
Const vbErrOutOfMemory As Long = 7
Const vbErrKeyAlreadyExists As Long = 457
Const chunkOverlap As Long = 1000
Static locToWebColl As Collection, lastTimeNotFound As Collection
Static lastCacheUpdate As Date
Dim resColl As Object, webRoot As String, locRoot As String
Dim vItem As Variant, s As String, keyExists As Boolean
Dim pmpo As String: pmpo = LCase(preferredMountPointOwner)
If Not locToWebColl Is Nothing And Not rebuildCache Then
Set resColl = New Collection: GetLocalPath = ""
For Each vItem In locToWebColl
locRoot = vItem(0): webRoot = vItem(1)
If InStr(1, path, webRoot, vbTextCompare) = 1 Then _
resColl.Add Key:=vItem(2), _
Item:=Replace(Replace(path, webRoot, locRoot, , 1), "/", ps)
Next vItem
If resColl.Count > 0 Then
If returnAll Then
For Each vItem In resColl: s = s & "//" & vItem: Next vItem
GetLocalPath = Mid(s, 3): Exit Function
End If
On Error Resume Next: GetLocalPath = resColl(pmpo): On Error GoTo 0
If GetLocalPath <> "" Then Exit Function
GetLocalPath = resColl(1): Exit Function
End If
If Not lastTimeNotFound Is Nothing Then
On Error Resume Next: lastTimeNotFound path
keyExists = (Err.Number = 0): On Error GoTo 0
If keyExists Then
If DateAdd("s", 1, lastTimeNotFound(path)) > Now() Then _
GetLocalPath = path: Exit Function
End If
End If
GetLocalPath = path
End If
Dim cid As String, fileNum As Long, line As Variant, parts() As String
Dim tag As String, mainMount As String, relPath As String, email As String
Dim b() As Byte, n As Long, i As Long, size As Long, libNr As String
Dim parentID As String, folderID As String, folderName As String
Dim folderIdPattern As String, fileName As String, folderType As String
Dim siteID As String, libID As String, webID As String, lnkID As String
Dim odFolders As Object, cliPolColl As Object, libNrToWebColl As Object
Dim sig1 As String: sig1 = StrConv(Chr$(&H2), vbFromUnicode)
Dim sig2 As String: sig2 = ChrW$(&H1) & String(3, vbNullChar)
Dim vbNullByte As String: vbNullByte = MidB$(vbNullChar, 1, 1)
Dim buffSize As Long, lastChunkEndPos As Long, lenDatFile As Long
Dim lastFileUpdate As Date
#If Mac Then
Dim utf16() As Byte, utf32() As Byte, j As Long, k As Long, m As Long
Dim charCode As Long, lowSurrogate As Long, highSurrogate As Long
ReDim b(0 To 3): b(0) = &HAB&: b(1) = &HAB&: b(2) = &HAB&: b(3) = &HAB&
Dim sig3 As String: sig3 = b: sig3 = vbNullChar & vbNullChar & sig3
#Else
ReDim b(0 To 1): b(0) = &HAB&: b(1) = &HAB&
Dim sig3 As String: sig3 = b: sig3 = vbNullChar & sig3
#End If
Dim settPath As String, wDir As String, clpPath As String
#If Mac Then
s = Environ("HOME")
settPath = Left(s, InStrRev(s, "/Library/Containers/")) & _
"Library/Containers/com.microsoft.OneDrive-mac/Data/" & _
"Library/Application Support/OneDrive/settings/"
clpPath = s & "/Library/Application Support/Microsoft/Office/CLP/"
#Else
settPath = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\"
clpPath = Environ("LOCALAPPDATA") & "\Microsoft\Office\CLP\"
#End If
#If Mac Then
Dim possibleDirs(0 To 11) As String: possibleDirs(0) = settPath
For i = 1 To 9: possibleDirs(i) = settPath & "Business" & i & ps: Next i
possibleDirs(10) = settPath & "Personal" & ps: possibleDirs(11) = clpPath
If Not GrantAccessToMultipleFiles(possibleDirs) Then _
Err.Raise vbErrPermissionDenied
#End If
Dim oneDriveSettDirs As Collection: Set oneDriveSettDirs = New Collection
Dim dirName As Variant: dirName = Dir(settPath, vbDirectory)
Do Until dirName = ""
If dirName = "Personal" Or dirName Like "Business#" Then _
oneDriveSettDirs.Add dirName
dirName = Dir(, vbDirectory)
Loop
#If Mac Then
s = ""
For Each dirName In oneDriveSettDirs
wDir = settPath & dirName & ps
cid = IIf(dirName = "Personal", "????????????????", _
"????????-????-????-????-????????????")
If dirName = "Personal" Then s = s & "//" & wDir & "GroupFolders.ini"
s = s & "//" & wDir & "global.ini"
fileName = Dir(wDir, vbNormal)
Do Until fileName = ""
If fileName Like cid & ".ini" Or _
fileName Like cid & ".dat" Or _
fileName Like "ClientPolicy*.ini" Then _
s = s & "//" & wDir & fileName
fileName = Dir
Loop
Next dirName
If Not GrantAccessToMultipleFiles(Split(Mid(s, 3), "//")) Then _
Err.Raise vbErrPermissionDenied
#End If
If Not locToWebColl Is Nothing And Not rebuildCache Then
s = ""
For Each dirName In oneDriveSettDirs
wDir = settPath & dirName & ps
cid = IIf(dirName = "Personal", "????????????????", _
"????????-????-????-????-????????????")
If Dir(wDir & "global.ini") <> "" Then _
s = s & "//" & wDir & "global.ini"
fileName = Dir(wDir, vbNormal)
Do Until fileName = ""
If fileName Like cid & ".ini" Then s = s & "//" & _
wDir & fileName
fileName = Dir
Loop
Next dirName
For Each vItem In Split(Mid(s, 3), "//")
If FileDateTime(vItem) > lastCacheUpdate Then _
rebuildCache = True: Exit For
Next vItem
If Not rebuildCache Then
If lastTimeNotFound Is Nothing Then _
Set lastTimeNotFound = New Collection
On Error Resume Next: lastTimeNotFound.Remove path: On Error GoTo 0
lastTimeNotFound.Add Item:=Now(), Key:=path
Exit Function
End If
End If
lastCacheUpdate = Now()
Set lastTimeNotFound = Nothing
Set locToWebColl = New Collection
For Each dirName In oneDriveSettDirs
wDir = settPath & dirName & ps
If Dir(wDir & "global.ini", vbNormal) = "" Then GoTo NextFolder
fileNum = FreeFile()
Open wDir & "global.ini" For Binary Access Read As #fileNum
ReDim b(0 To LOF(fileNum)): Get fileNum, , b
Close #fileNum: fileNum = 0
#If Mac Then
b = StrConv(b, vbUnicode)
#End If
For Each line In Split(b, vbNewLine)
If line Like "cid = *" Then cid = Mid(line, 7): Exit For
Next line
If cid = "" Then GoTo NextFolder
If (Dir(wDir & cid & ".ini") = "" Or _
Dir(wDir & cid & ".dat") = "") Then GoTo NextFolder
If dirName Like "Business#" Then
folderIdPattern = Replace(Space(32), " ", "[a-f0-9]")
ElseIf dirName = "Personal" Then
folderIdPattern = Replace(Space(16), " ", "[A-F0-9]") & "!###*"
End If
fileName = Dir(clpPath, vbNormal)
Do Until fileName = ""
i = InStrRev(fileName, cid, , vbTextCompare)
If i > 1 And cid <> "" Then _
email = LCase(Left(fileName, i - 2)): Exit Do
fileName = Dir
Loop
Set cliPolColl = New Collection
fileName = Dir(wDir, vbNormal)
Do Until fileName = ""
If fileName Like "ClientPolicy*.ini" Then
fileNum = FreeFile()
Open wDir & fileName For Binary Access Read As #fileNum
ReDim b(0 To LOF(fileNum)): Get fileNum, , b
Close #fileNum: fileNum = 0
#If Mac Then
b = StrConv(b, vbUnicode)
#End If
cliPolColl.Add Key:=fileName, Item:=New Collection
For Each line In Split(b, vbNewLine)
If InStr(1, line, " = ", vbBinaryCompare) Then
tag = Left(line, InStr(line, " = ") - 1)
s = Mid(line, InStr(line, " = ") + 3)
Select Case tag
Case "DavUrlNamespace"
cliPolColl(fileName).Add Key:=tag, Item:=s
Case "SiteID", "IrmLibraryId", "WebID"
s = Replace(LCase(s), "-", "")
If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
cliPolColl(fileName).Add Key:=tag, Item:=s
End Select
End If
Next line
End If
fileName = Dir
Loop
buffSize = -1
Try: On Error GoTo Catch
Set odFolders = New Collection
lastChunkEndPos = 1: i = 0
lastFileUpdate = FileDateTime(wDir & cid & ".dat")
Do
If FileDateTime(wDir & cid & ".dat") > lastFileUpdate Then GoTo Try
fileNum = FreeFile
Open wDir & cid & ".dat" For Binary Access Read As #fileNum
lenDatFile = LOF(fileNum)
If buffSize = -1 Then buffSize = lenDatFile
ReDim b(0 To buffSize + chunkOverlap)
Get fileNum, lastChunkEndPos, b: s = b: size = LenB(s)
Close #fileNum: fileNum = 0
lastChunkEndPos = lastChunkEndPos + buffSize
For vItem = 16 To 8 Step -8
i = InStrB(vItem + 1, s, sig2)
Do While i > vItem And i < size - 168
If MidB$(s, i - vItem, 1) = sig1 Then
i = i + 8: n = InStrB(i, s, vbNullByte) - i
If n < 0 Then n = 0
If n > 39 Then n = 39
folderID = StrConv(MidB$(s, i, n), vbUnicode)
i = i + 39: n = InStrB(i, s, vbNullByte) - i
If n < 0 Then n = 0
If n > 39 Then n = 39
parentID = StrConv(MidB$(s, i, n), vbUnicode)
i = i + 121: n = -Int(-(InStrB(i, s, sig3) - i) / 2) * 2
If n < 0 Then n = 0
#If Mac Then
utf32 = MidB$(s, i, n)
ReDim utf16(LBound(utf32) To UBound(utf32))
j = LBound(utf32): k = LBound(utf32)
Do While j < UBound(utf32)
If utf32(j + 2) = 0 And utf32(j + 3) = 0 Then
utf16(k) = utf32(j)
utf16(k + 1) = utf32(j + 1)
k = k + 2
Else
If utf32(j + 3) <> 0 Then Err.Raise _
vbErrInvalidFormatInResourceFile
charCode = utf32(j + 2) * &H10000 + _
utf32(j + 1) * &H100& + utf32(j)
m = charCode - &H10000
highSurrogate = &HD800& + (m \ &H400&)
lowSurrogate = &HDC00& + (m And &H3FF)
utf16(k) = CByte(highSurrogate And &HFF&)
utf16(k + 1) = CByte(highSurrogate \ &H100&)
utf16(k + 2) = CByte(lowSurrogate And &HFF&)
utf16(k + 3) = CByte(lowSurrogate \ &H100&)
k = k + 4
End If
j = j + 4
Loop
ReDim Preserve utf16(LBound(utf16) To k - 1)
folderName = utf16
#Else
folderName = MidB$(s, i, n)
#End If
If folderID Like folderIdPattern Then
odFolders.Add VBA.Array(parentID, folderName), _
folderID
End If
End If
i = InStrB(i + 1, s, sig2)
Loop
If odFolders.Count > 0 Then Exit For
Next vItem
Loop Until lastChunkEndPos >= lenDatFile _
Or buffSize >= lenDatFile
GoTo Continue
Catch:
If Err.Number = vbErrKeyAlreadyExists Then
odFolders.Remove folderID
Resume
End If
If Err.Number <> vbErrOutOfMemory Then Err.Raise Err
If buffSize > &HFFFFF Then buffSize = buffSize / 2: Resume Try
Err.Raise Err
Continue: On Error GoTo 0
fileNum = FreeFile()
Open wDir & cid & ".ini" For Binary Access Read As #fileNum
ReDim b(0 To LOF(fileNum)): Get fileNum, , b
Close #fileNum: fileNum = 0
#If Mac Then
b = StrConv(b, vbUnicode)
#End If
Select Case True
Case dirName Like "Business#"
mainMount = "": Set libNrToWebColl = New Collection
For Each line In Split(b, vbNewLine)
webRoot = "": locRoot = ""
Select Case Left$(line, InStr(line, " = ") - 1)
Case "libraryScope"
parts = Split(line, """"): locRoot = parts(9)
If locRoot = "" Then libNr = Split(line, " ")(2)
folderType = parts(3): parts = Split(parts(8), " ")
siteID = parts(1): webID = parts(2): libID = parts(3)
If mainMount = "" And folderType = "ODB" Then
mainMount = locRoot: fileName = "ClientPolicy.ini"
Else: fileName = "ClientPolicy_" & libID & siteID & ".ini"
End If
On Error Resume Next
webRoot = cliPolColl(fileName)("DavUrlNamespace")
On Error GoTo 0
If webRoot = "" Then
For Each vItem In cliPolColl
If vItem("SiteID") = siteID _
And vItem("WebID") = webID _
And vItem("IrmLibraryId") = libID Then
webRoot = vItem("DavUrlNamespace"): Exit For
End If
Next vItem
End If
If webRoot = "" Then Err.Raise vbErrFileNotFound
If locRoot = "" Then
libNrToWebColl.Add VBA.Array(libNr, webRoot), libNr
Else: locToWebColl.Add VBA.Array(locRoot, webRoot, email) _
, locRoot
End If
Case "libraryFolder"
locRoot = Split(line, """")(1): libNr = Split(line, " ")(3)
For Each vItem In libNrToWebColl
If vItem(0) = libNr Then
s = "": parentID = Left(Split(line, " ")(4), 32)
Do
On Error Resume Next: odFolders parentID
keyExists = (Err.Number = 0): On Error GoTo 0
If Not keyExists Then Exit Do
s = odFolders(parentID)(1) & "/" & s
parentID = odFolders(parentID)(0)
Loop
webRoot = vItem(1) & s: Exit For
End If
Next vItem
locToWebColl.Add VBA.Array(locRoot, webRoot, email), locRoot
Case "AddedScope"
parts = Split(line, """")
relPath = parts(5): If relPath = " " Then relPath = ""
parts = Split(parts(4), " "): siteID = parts(1)
webID = parts(2): libID = parts(3): lnkID = parts(4)
fileName = "ClientPolicy_" & libID & siteID & lnkID & ".ini"
On Error Resume Next
webRoot = cliPolColl(fileName)("DavUrlNamespace") & relPath
On Error GoTo 0
If webRoot = "" Then
For Each vItem In cliPolColl
If vItem("SiteID") = siteID _
And vItem("WebID") = webID _
And vItem("IrmLibraryId") = libID Then
webRoot = vItem("DavUrlNamespace") & relPath
Exit For
End If
Next vItem
End If
If webRoot = "" Then Err.Raise vbErrFileNotFound
s = "": parentID = Left(Split(line, " ")(3), 32)
Do
On Error Resume Next: odFolders parentID
keyExists = (Err.Number = 0): On Error GoTo 0
If Not keyExists Then Exit Do
s = odFolders(parentID)(1) & ps & s
parentID = odFolders(parentID)(0)
Loop
locRoot = mainMount & ps & s
locToWebColl.Add VBA.Array(locRoot, webRoot, email), locRoot
Case Else
Exit For
End Select
Next line
Case dirName = "Personal"
For Each line In Split(b, vbNewLine)
If line Like "library = *" Then _
locRoot = Split(line, """")(3): Exit For
Next line
On Error Resume Next
webRoot = cliPolColl("ClientPolicy.ini")("DavUrlNamespace")
On Error GoTo 0
If locRoot = "" Or webRoot = "" Or cid = "" Then GoTo NextFolder
locToWebColl.Add VBA.Array(locRoot, webRoot & "/" & cid, email), _
locRoot
If Dir(wDir & "GroupFolders.ini") = "" Then GoTo NextFolder
cid = "": fileNum = FreeFile()
Open wDir & "GroupFolders.ini" For Binary Access Read As #fileNum
ReDim b(0 To LOF(fileNum)): Get fileNum, , b
Close #fileNum: fileNum = 0
#If Mac Then
b = StrConv(b, vbUnicode)
#End If
For Each line In Split(b, vbNewLine)
If InStr(line, "BaseUri = ") And cid = "" Then
cid = LCase(Mid(line, InStrRev(line, "/") + 1, 16))
folderID = Left(line, InStr(line, "_") - 1)
ElseIf cid <> "" Then
locToWebColl.Add VBA.Array(locRoot & ps & odFolders( _
folderID)(1), webRoot & "/" & cid & "/" & _
Mid(line, Len(folderID) + 9), email), _
locRoot & ps & odFolders(folderID)(1)
cid = "": folderID = ""
End If
Next line
End Select
NextFolder:
cid = "": s = "": email = "": Set odFolders = Nothing
Next dirName
Dim tmpColl As Collection: Set tmpColl = New Collection
For Each vItem In locToWebColl
locRoot = vItem(0): webRoot = vItem(1): email = vItem(2)
If Right(webRoot, 1) = "/" Then webRoot = Left(webRoot, Len(webRoot) - 1)
If Right(locRoot, 1) = ps Then locRoot = Left(locRoot, Len(locRoot) - 1)
tmpColl.Add VBA.Array(locRoot, webRoot, email), locRoot
Next vItem
Set locToWebColl = tmpColl
GetLocalPath = GetLocalPath(path, False, returnAll, pmpo): Exit Function
End Function
솔루션 구조
모두 수 있습니다.UrlPath/WebPath a까지LocalPath 내의 로부터, OneDrive 설정 파일로부터.%localappdata%\Microsoft\OneDrive\settings\....
즉, 대부분의 온라인 솔루션과 달리 레지스트리는 사용되지 않습니다.그 이유는 솔루션 2의 Gist 저장소에 설명되어 있습니다.
다음 파일을 읽을 수 있습니다.
(Wildcards:* - 0자 이상,? (1글자)
????????????????.dat
????????????????.ini
global.ini
GroupFolders.ini
????????-????-????-????-????????????.dat
????????-????-????-????-????????????.ini
ClientPolicy*.ini
<고객명>님.iniUTF-16 인코딩을 사용하기 때문에 파일을 쉽게 읽을 수 있습니다..dat파일은 독자적인 바이너리 형식을 사용하기 때문에 해독하기가 훨씬 어렵습니다.다행히 이러한 파일 내에서 특정 바이트 패턴을 찾고 이러한 "시그니처" 바이트에서 특정 오프셋으로 데이터를 복사 및 변환함으로써 필요한 정보를 추출할 수 있습니다.
하는 PC의 모든 로컬마운트 WebPath OneDrive의 예를 、 one one 、 OneDrive 、 drive .음음음음음음 . 。C:\Users\Username\OneDrive하는 " " " 입니다WebPath될 수 요.https://d.docs.live.net/f9d8c1184686d493.
은 '을 할 때 할 수 있습니다.WebPath사전의 요소 중 하나와 동일한 부분을 해당하는 로컬 마운트 포인트로 대체하여 로컬 경로로 이동합니다.를 들면, 이 「」, 「」입니다.WebPathhttps://d.docs.live.net/f9d8c1184686d493/Folder/File.xlsm 있을 입니다.C:\Users\Username\OneDrive\Folder\File.xlsm
모든 것이 가능하기 때문이다.WebPaths할 수 은 「어느 사전으로 할 수 있다」, 「어느 사전으로 할 수 있다」, 「어느 사전으로 할 수 있다」라고 합니다.Static두 솔루션 모두.즉, 함수가 처음 호출될 때만 작성되며, 이후의 모든 함수 호출은 이미 초기화된 "사전"을 발견하여 실행 시간이 단축됩니다.
솔루션 테스트 및 비교
온라인에서 찾을 수 있는 모든 솔루션에 대해 광범위한 테스트를 실시했습니다.이러한 테스트의 선택사항이 여기에 제시됩니다.
테스트한 솔루션의 일부를 다음에 나타냅니다.
아래 그림의 표에서 각 행은 위 표의 1개의 솔루션을 나타내며 솔루션 번호를 사용하여 관련지을 수 있습니다.
마찬가지로 각 열은 검정 사례를 나타내므로 검정 번호를 사용하여 이 검정 표와 연관시킬 수 있습니다.유감스럽게도 Stack Overflow에서는 테스트 케이스의 표를 이 투고에 직접 포함할 수 있을 만큼 답변이 길지 않습니다.
이 테스트는 모두 Windows에서 실시되었습니다.MacOS에서는 Nr 33을 제외한 모든 솔루션이 0/46 테스트에 합격합니다.제 솔루션(Nr 33)도 MacOS의 모든 테스트에 합격할 것으로 생각됩니다만, 엄밀하게 테스트하지 못했습니다.
대부분의 솔루션은 매우 적은 수의 테스트를 통과합니다.이러한 테스트의 대부분은 비교적 해결하기 어려운 문제이며, Nr 41~46 테스트와 같이 솔루션이 여러 개의 서로 다른 로컬 경로에 동기화된 OneDrive 폴더를 처리하는 방법을 테스트하는 절대 에지 케이스도 있습니다. 이 테스트는 여러 Business OneDrive 계정이 동일한 PC에 로그인되어 있고 특별한 설정이 필요한 경우에만 발생할 수 있습니다.(자세한 내용은 스레드2를 참조해 주세요).
테스트 Nr 22에는 일부 폴더 이름에 다양한 Unicode 이모티콘 문자가 포함되어 있습니다.이 때문에 많은 솔루션이 오류로 인해 실패합니다.
많은 솔루션의 퍼포먼스가 저조한 또 다른 이유는 환경변수가Environ("OneDrive"),Environ("OneDriveCommercial") ,Environ("OneDriveConsumer")많은 솔루션이 기반으로 구축되어 있기 때문에 신뢰할 수 없습니다. 특히 저처럼 여러 비즈니스용 OneDrive 계정이 동시에 로그인되어 있는 경우에는 더욱 그렇습니다.항상 기대치를 반환하더라도 모든 사례를 해결하기 위해서는 정보가 거의 필요하지 않다는 점에 유의하시기 바랍니다.
테스트하고 싶은 다른 솔루션이 있으면 알려 주십시오.이 섹션에 추가합니다.
저는 온라인에서 이 문제를 해결하기 위해 간단한 정보를 합칠 수 있는 스레드를 찾았습니다.저는 실제로 루비로 솔루션을 구현했습니다만, 이것은 VBA 버전입니다.
Option Explicit
Private Function Local_Workbook_Name(ByRef wb As Workbook) As String
Dim Ctr As Long
Dim objShell As Object
Dim UserProfilePath As String
'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
'Replace forward slashes with back slashes
Local_Workbook_Name = Replace(wb.FullName, "/", "\")
'Get environment path using vbscript
Set objShell = CreateObject("WScript.Shell")
UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")
'Trim OneDrive designators
For Ctr = 1 To 4
Local_Workbook_Name = Mid(Local_Workbook_Name, InStr(Local_Workbook_Name, "\") + 1)
Next
'Construct the name
Local_Workbook_Name = UserProfilePath & "\OneDrive\" & Local_Workbook_Name
Else
Local_Workbook_Name = wb.FullName
End If
End Function
Private Sub testy()
MsgBox ActiveWorkbook.FullName & vbCrLf & Local_Workbook_Name(ActiveWorkbook)
End Sub
Horoman 버전(2020-03-30)은 개인 및 상용 OneDrive에서 모두 사용할 수 있어 좋습니다.그러나 "LocalFullName = oneDrivePath & Application"이라는 줄 때문에 충돌했습니다.PathSeparator & endFilePath"는 1DrivePath와 endFilePath 사이에 슬래시를 삽입합니다.또한 "OneDrive"보다 "OneDriveCommercial"과 "OneDriveConsumer"를 먼저 사용해 보아야 합니다.나에게 유효한 코드는 다음과 같습니다.
Sub TestLocalFullName()
Debug.Print "URL: " & ActiveWorkbook.FullName
Debug.Print "Local: " & LocalFullName(ActiveWorkbook.FullName)
Debug.Print "Test: " & Dir(LocalFullName(ActiveWorkbook.FullName))
End Sub
Private Function LocalFullName$(ByVal fullPath$)
'Finds local path for a OneDrive file URL, using environment variables of OneDrive
'Reference https://stackoverflow.com/questions/33734706/excels-fullname-property-with-onedrive
'Authors: Philip Swannell 2019-01-14, MatChrupczalski 2019-05-19, Horoman 2020-03-29, P.G.Schild 2020-04-02
Dim ii&
Dim iPos&
Dim oneDrivePath$
Dim endFilePath$
If Left(fullPath, 8) = "https://" Then 'Possibly a OneDrive URL
If InStr(1, fullPath, "my.sharepoint.com") <> 0 Then 'Commercial OneDrive
'For commercial OneDrive, path looks like "https://companyName-my.sharepoint.com/personal/userName_domain_com/Documents" & file.FullName)
'Find "/Documents" in string and replace everything before the end with OneDrive local path
iPos = InStr(1, fullPath, "/Documents") + Len("/Documents") 'find "/Documents" position in file URL
endFilePath = Mid(fullPath, iPos) 'Get the ending file path without pointer in OneDrive. Include leading "/"
Else 'Personal OneDrive
'For personal OneDrive, path looks like "https://d.docs.live.net/d7bbaa#######1/" & file.FullName
'We can get local file path by replacing "https.." up to the 4th slash, with the OneDrive local path obtained from registry
iPos = 8 'Last slash in https://
For ii = 1 To 2
iPos = InStr(iPos + 1, fullPath, "/") 'find 4th slash
Next ii
endFilePath = Mid(fullPath, iPos) 'Get the ending file path without OneDrive root. Include leading "/"
End If
endFilePath = Replace(endFilePath, "/", Application.PathSeparator) 'Replace forward slashes with back slashes (URL type to Windows type)
For ii = 1 To 3 'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
oneDrivePath = Environ(Choose(ii, "OneDriveCommercial", "OneDriveConsumer", "OneDrive")) 'Check possible local paths. "OneDrive" should be the last one
If 0 < Len(oneDrivePath) Then
LocalFullName = oneDrivePath & endFilePath
Exit Function 'Success (i.e. found the correct Environ parameter)
End If
Next ii
'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
LocalFullName = vbNullString
Else
LocalFullName = fullPath
End If
End Function
다른 사용자가 제공하는 기능을 조정하여 몇 가지 추가 제약사항을 고려했습니다.
팀 사이트를 통해 파일을 공유하는 경우 상용 버전인지 여부를 판단하기 위해 사용해야 하는 것은 "my.sharepoint.com/"이 아니라 "sharepoint.com/"입니다.
예를 들어 프랑스어에서는 문서 폴더를 "Documents partages"라고 부르므로 "/Documents" 위치를 사용하는 것보다 슬래시를 세는 것이 좋습니다.상업용 슬래시 4개, 개인용 슬래시 2개를 세는 것이 좋습니다.
OneDrive 바로 가기로 추가된 쉐어포인트 폴더가 루트에 없는 경우 하드 드라이브의 로컬 주소에 쉐어포인트의 상위 폴더가 포함되어 있지 않습니다.
다음은 변경 사항을 고려한 코드입니다.
Public Function AdresseLocal$(ByVal fullPath$)
'Finds local path for a OneDrive file URL, using environment variables of OneDrive
'Reference https://stackoverflow.com/questions/33734706/excels-fullname-property-with-onedrive
'Authors: Philip Swannell 2019-01-14, MatChrupczalski 2019-05-19, Horoman 2020-03-29, P.G.Schild 2020-04-02
Dim ii&
Dim iPos&
Dim oneDrivePath$
Dim endFilePath$
Dim NbSlash
If Left(fullPath, 8) = "https://" Then
If InStr(1, fullPath, "sharepoint.com/") <> 0 Then 'Commercial OneDrive
NbSlash = 4
Else 'Personal OneDrive
NbSlash = 2
End If
iPos = 8 'Last slash in https://
For ii = 1 To NbSlash
iPos = InStr(iPos + 1, fullPath, "/")
Next ii
endFilePath = Mid(fullPath, iPos)
endFilePath = Replace(endFilePath, "/", Application.PathSeparator)
For ii = 1 To 3
oneDrivePath = Environ(Choose(ii, "OneDriveCommercial", "OneDriveConsumer", "OneDrive"))
If 0 < Len(oneDrivePath) Then Exit For
Next ii
AdresseLocal = oneDrivePath & endFilePath
While Len(Dir(AdresseLocal, vbDirectory)) = 0 And InStr(2, endFilePath, Application.PathSeparator) > 0
endFilePath = Mid(endFilePath, InStr(2, endFilePath, Application.PathSeparator))
AdresseLocal = oneDrivePath & endFilePath
Wend
Else
AdresseLocal = fullPath
End If
End Function
...그것은 다른 기여자들의 작업을 기반으로 합니다.
Virtuoso의 답변을 개선하여 함수가 "잘못된" 파일 위치를 반환할 가능성을 줄일 수 있습니다.입니다..FullName가 알고 세 가지는 과 같습니다.제가 알고 있는 세 가지는 다음과 같습니다.
- 사용자의 OneDrive와 관련된 URL
- 사용자의 OneDrive for Business와 관련된 URL
- 다른 사람이 파일을 "공유"한 경우(이 경우 [File]> [ Open ]> [ Shared with me ]에서 파일을 엽니다) 다른 사람의 OneDrive와 관련된 URL
위한 를 PC에서 수 .OneDriveConsumer ★★★★★★★★★★★★★★★★★」OneDriveCommercial, , 환경변수, 환경변수, 환경변수, 환경변수OneDrive환경변수이므로 아래 코드는 이들을 사용합니다. Me"할 수 것을 는 "Shared with Me" 파일을 합니다.https://- location - style 케케 - -
Private Function Local_Workbook_Name(ByRef wb As Workbook) As String
Dim i As Long, j As Long
Dim OneDrivePath As String
Dim ShortName As String
'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
'Replace forward slashes with back slashes
ShortName = Replace(wb.FullName, "/", "\")
'Remove the first four backslashes
For i = 1 To 4
ShortName = Mid(ShortName, InStr(ShortName, "\") + 1)
Next
'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
For j = 1 To 3
OneDrivePath = Environ(Choose(j, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
If Len(OneDrivePath) > 0 Then
Local_Workbook_Name = OneDrivePath & "\" & ShortName
If Dir(Local_Workbook_Name) <> "" Then
Exit Function
End If
End If
Next j
'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
End If
Local_Workbook_Name = wb.FullName
End Function
안타깝게도 OneDrive 폴더와 OneDrive for Business 폴더 내에 동일한 경로를 가진 파일이 있는 경우 코드가 이들을 구분할 수 없으며 "잘못된 파일"을 반환할 수 있습니다.나는 그것에 대한 해결책이 없다.
레지스트리를 사용한 TWMIC 버전이 마음에 듭니다.다른 모든 버전은 OneDrive for Business에서 작동하지 않았습니다.이름이 URL과 약간 다른 폴더가 있습니다.예를 들어 URL에는 공백이 없지만 폴더에는 공백이 있습니다.팀명 안에 공백이 있는 경우 문제가 있습니다.팀의 폴더 이름도 동기화하는 팀의 폴더 수준에 따라 URL과 다릅니다.
TWMIC의 버전이 업무용 컴퓨터에서 위험하다고 태그되어 사용할 수 없습니다.그 점은 매우 유감입니다.그래서 Busines용 OneDrive에서 ini 파일을 읽는 버전을 만들었습니다. Business용 OneDrive라면...
Public Function AdresseLocal$(ByVal fullPath$)
'Finds local path for a OneDrive file URL, using environment variables of OneDrive and loading the settings ini File of OneDrive
'Reference https://stackoverflow.com/questions/33734706/excels-fullname-property-with-onedrive
'Authors: Philip Swannell 2019-01-14, MatChrupczalski 2019-05-19, Horoman 2020-03-29, P.G.Schild 2020-04-02, Iksi 2021-08-28
Dim ScreenUpdate As Boolean
Dim ii&
Dim iPos&
Dim DatFile$, SettingsDir$, Temp$
Dim oneDrivePath$, oneDriveURL$
Dim endFilePath$
If Left(fullPath, 8) = "https://" Then
If InStr(1, fullPath, "sharepoint.com") <> 0 Then 'Commercial OneDrive
'Find the correct settings File, I'm not sure if it is always in Folder Business1, so trying to find a Folder Business and then Business1, 2 ....
'First find *.dat File, seems to be only one of that type, the correct ini File is the same Name than the dat File
DatFile = Dir(Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business\*.dat")
If DatFile <> "" Then SettingsDir = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business\"
For ii = 1 To 9
Temp = Dir(Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business" & ii & "\*.dat")
If Temp <> "" Then
If SettingsDir = "" Then
DatFile = Temp
SettingsDir = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\Business" & ii & "\"
Else
MsgBox "There is more than one OneDrive settings Folder!"
End If
End If
Next
'Open ini File without showing
ScreenUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
Workbooks.OpenText Filename:= _
SettingsDir & Left(DatFile, Len(DatFile) - 3) & "ini" _
, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:= _
False, Comma:=False, Space:=True, Other:=False, TrailingMinusNumbers:=True
ii = 1
Do While Cells(ii, 1) = "libraryScope"
'Search the correct URL which fits to the fullPath and then search the corresponding Folder
If InStr(fullPath, Cells(ii, 9)) = 1 Then
oneDriveURL = Cells(ii, 9)
If Cells(ii, 15) <> "" Then
oneDrivePath = Cells(ii, 15)
Else
iPos = Cells(ii, 3)
Do Until Cells(ii, 1) = "libraryFolder"
ii = ii + 1
Loop
Do While Cells(ii, 1) = "libraryFolder"
If Cells(ii, 4) = iPos Then
oneDrivePath = Cells(ii, 7)
Exit Do
End If
ii = ii + 1
Loop
End If
Exit Do
End If
ii = ii + 1
Loop
ActiveWorkbook.Close False
Application.ScreenUpdating = ScreenUpdate
endFilePath = Mid(fullPath, Len(oneDriveURL) + 1)
Else 'Personal OneDrive
'For personal OneDrive, path looks like "https://d.docs.live.net/d7bbaa#######1/" & file.FullName
'We can get local file path by replacing "https.." up to the 4th slash, with the OneDrive local path obtained from registry
iPos = 8 'Last slash in https://
For ii = 1 To 2
iPos = InStr(iPos + 1, fullPath, "/") 'find 4th slash
Next ii
endFilePath = Mid(fullPath, iPos) 'Get the ending file path without OneDrive root. Include leading "/"
End If
endFilePath = Replace(endFilePath, "/", Application.PathSeparator)
If Len(oneDrivePath) <= 0 Then
For ii = 1 To 3 'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
oneDrivePath = Environ(Choose(ii, "OneDriveCommercial", "OneDriveConsumer", "OneDrive")) 'Check possible local paths. "OneDrive" should be the last one
Next ii
End If
AdresseLocal = oneDrivePath & endFilePath
While Len(Dir(AdresseLocal, vbDirectory)) = 0 And InStr(2, endFilePath, Application.PathSeparator) > 0
endFilePath = Mid(endFilePath, InStr(2, endFilePath, Application.PathSeparator))
AdresseLocal = oneDrivePath & endFilePath
Wend
Else
AdresseLocal = fullPath
End If
End Function
나한텐 이게 잘 먹혀!
Easy Fix(2019년 초) - 이 문제가 있는 다른 사용자:
OneDrive > Settings > Office: - [Office 어플리케이션을 사용하여 여는 Office 파일을 동기화한다]체크박스를 끄겠습니다
이를 통해 Excel은 일반적인 "C:"에 파일을 저장할 수 있습니다.\Users[UserName]\OneDrive...UNC "https" 대신 파일 형식:\"형식입니다.
쇼트 솔루션
다음에 나타내는 솔루션이 반드시 모든 경우에서 동작하는 것은 아니지만, 실제 시나리오의 99% 이상에서 동작하는 경우가 있습니다.엣지 케이스까지 커버할 수 있는 솔루션을 찾고 계신 분은, 이 범용 솔루션을 봐 주세요.
위의 링크된 범용 솔루션에 비해 이 솔루션의 장점은 단순성이며 OneDrive/Windows 업데이트로 인해 고장날 가능성이 낮다는 것입니다.
를 입니다.WebPath로컬 패스에 대한 자세한 내용은 다음과 같습니다.
Public Function GetLocalPath(ByVal Path As String) As String
Const HKCU = &H80000001
Dim objReg As Object, rPath As String, subKeys(), subKey
Dim urlNamespace As String, mountPoint As String, secPart As String
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\." & _
"\root\default:StdRegProv")
rPath = "Software\SyncEngines\Providers\OneDrive\"
objReg.EnumKey HKCU, rPath, subKeys
For Each subKey In subKeys
objReg.GetStringValue HKCU, rPath & subKey, "UrlNamespace", urlNamespace
If InStr(Path, urlNamespace) > 0 Then
objReg.GetStringValue HKCU, rPath & subKey, "MountPoint", mountPoint
secPart = Replace(Mid(Path, Len(urlNamespace)), "/", "\")
Path = mountPoint & secPart
Do Until Dir(Path, vbDirectory) <> "" Or InStr(2, secPart, "\") = 0
secPart = Mid(secPart, InStr(2, secPart, "\"))
Path = mountPoint & secPart
Loop
Exit For
End If
Next
GetLocalPath = Path
End Function
, 「」를 .GetLocalPath(ThisWorkbook.FullName)
큰 도움이 됐어요, 고마워요.비슷한 문제가 있었지만 파일명이 아닌 폴더명이었습니다.그래서 조금 수정했습니다.폴더 이름 및 파일 이름(워크북일 필요는 없음)에 대해 작업을 수행했습니다.도움이 되는 경우 코드는 다음과 같습니다.
Public Function Local_Name(theName As String) As String
Dim i As Integer
Dim objShell As Object
Dim UserProfilePath As String
' Check if it looks like a OneDrive location.
If InStr(1, theName, "https://", vbTextCompare) > 0 Then
' Replace forward slashes with back slashes.
Local_Name = Replace(theName, "/", "\")
'Get environment path using vbscript.
Set objShell = CreateObject("WScript.Shell")
UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")
' Trim OneDrive designators.
For i = 1 To 4
Local_Name = Mid(Local_Name, InStr(Local_Name, "\") + 1)
Next i
' Construct the name.
Local_Name = UserProfilePath & "\OneDrive\" & Local_Name
Else
' (must already be local).
Local_Name = theName
End If
End Function
★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★일부 윈도우 10 머신에서는 이 문제가 발생했지만 다른 머신에서는 발생하지 않아 문제가 발생하고 있는 것 같습니다.OneDrive 리 one정 、 one one one one one one one one one one 。적어도 내 기계에서 작동하려고 했던 것은Fullname=CurDir&FileName 「」가 아닌 「」FullName= activeworkbook.Path&FileName.
이렇게 하면 https를 사용하지 않고 완전한 로컬 이름이 반환되어 파일을 정상적으로 열 수 있었습니다.
나도 너와 같은 문제가 있어.하지만 나는 그 문제를 해결했다.스크립트를 실행하기 전에 OneDrive를 꺼야 합니다.
첫 번째 스크립트의 다음 스크립트를 vba/module에 추가할 수 있습니다.
Call Shell("cmd.exe /S /C" & "%LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /shutdown")
그런 다음 vba/모듈의 마지막 스크립트에 OneDrive를 활성화하기 위해 다음을 삽입할 수 있습니다.
Call Shell("cmd.exe /S /C" & "start %LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /background")
그 스크립트로 Windows 10을 사용하고 있습니다.
변수 ThisWorkbook을 사용하는 대신.패스 사용 환경("One Drive")
Option Explicit
'
Function TransferURL(wbkURL As String) As String
' Converts the URL of a OneDrive into a path.
' Returns the path's name.
Dim oFs As Object
Dim oFl As Object
Dim oSubFl As Object
Dim pos As Integer
Dim pathPart As String
Dim oneDrive As String
Dim subFl As String
Set oFs = CreateObject("Scripting.FileSystemObject")
' Check the version of OneDrive.
If VBA.InStr(1, _
VBA.UCase(wbkURL), "MY.SHAREPOINT.COM") = 0 Then
oneDrive = "OneDriveConsumer"
Else
oneDrive = "OneDriveCommercial"
End If
Set oFl = oFs.GetFolder(Environ(oneDrive))
' Iteration over OneDrive's subfolders.
For Each oSubFl In oFl.SUBFOLDERS
subFl = "/" & VBA.Mid(oSubFl.Path, _
VBA.Len(Environ(oneDrive)) + 2) & "/"
' Check if part of the URL.
If VBA.InStr(1, _
wbkURL, subFl) > 0 Then
' Determine the path after OneDrive's folder.
pos = VBA.InStr(1, _
wbkURL, subFl)
pathPart = VBA.Mid(VBA.Replace(wbkURL, "/", _
Application.PathSeparator), pos)
End If
Next
TransferURL = Environ(oneDrive) & pathPart
End Function
함수를 호출하는 방법:
' Check if path specification as URL.
If VBA.Left(VBA.UCase(oWbk.Path), _
5) = "HTTPS" Then
' Call ...
pathName = TransferURL(oWbk.Path)
End If
OneDriveConsumer와 OneDriveCommercial의 차이점은 다음과 같습니다.
MatChrupczalski 편집 : 2019년 5월 9일 (목) 오후 5:45
Option Explicit
Private coll_Locations As Collection ' using Collection but could just as easily use Dictionary
Public Const HKEY_CURRENT_USER = &H80000001
'
Public Function getOneDrv_PathFor(ByVal sPath As String, Optional ByVal sType As String = "") As String
' convert start of passed in path from URL to Local or vice.versa, (for OneDrive Sync'd folders)
' sType : if starts L(ocal) return local path, if starts U(rl) then return URL Path, else return other mode to that passed in
Dim sPathNature As String
Dim vKey As Variant
Dim Slash As String, Slash2 As String
getOneDrv_PathFor = sPath ' return unchanged if no action required or recognised
sType = UCase(Left(sType, 1))
If sType <> "L" And sType <> "U" Then sType = ""
sPathNature = IIf(Left(sPath, 4) = "http", "U", "L")
If sType <> "" And sType = sPathNature Then Exit Function ' nothing to do
If coll_Locations Is Nothing Then get_Locations
For Each vKey In coll_Locations
If InStr(1, sPath, vKey, vbTextCompare) = 1 Then
Slash = IIf(sPathNature = "U", "/", "\")
Slash2 = IIf(Slash = "/", "\", "/")
getOneDrv_PathFor = coll_Locations(vKey) & Replace(Mid(sPath, Len(vKey) + 1), Slash, Slash2)
Exit For
End If
Next
End Function
Private Sub get_Locations()
' collect possible OneDrive: URL vs Local paths
Dim oWMI As Object
Dim sRegPath As String, arrSubKeys() As Variant, vSubKey As Variant
Dim sServiceEndPointUri As String, sUserFolder As String
Set coll_Locations = New Collection
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
sRegPath = "Software\Microsoft\OneDrive\Accounts\"
oWMI.EnumKey HKEY_CURRENT_USER, sRegPath, arrSubKeys
For Each vSubKey In arrSubKeys
oWMI.GetStringValue HKEY_CURRENT_USER, sRegPath & vSubKey, "ServiceEndPointUri", sServiceEndPointUri
oWMI.GetStringValue HKEY_CURRENT_USER, sRegPath & vSubKey, "UserFolder", sUserFolder
If sServiceEndPointUri <> "" And sUserFolder <> "" Then
If Right(sServiceEndPointUri, 5) = "/_api" Then sServiceEndPointUri = Left(sServiceEndPointUri, Len(sServiceEndPointUri) - 4) & "Documents/"
sUserFolder = sUserFolder & "\"
coll_Locations.Add Item:=sServiceEndPointUri, Key:=sUserFolder
coll_Locations.Add Item:=sUserFolder, Key:=sServiceEndPointUri
End If
Next
'listOneDrv_Locations
Set oWMI = Nothing
End Sub
Public Sub listOneDrv_Locations()
' to list what's in the collection
Dim vKey As Variant
' Set coll_Locations = Nothing
If coll_Locations Is Nothing Then get_Locations
For Each vKey In coll_Locations
Debug.Print vKey, coll_Locations(vKey)
Next
End Sub
그런 다음 LocalPath를 가져오려면 strLocalPath = getOneDrv_PathFor(strCurrentPath, "Local")가 됩니다.
질문이 VBA 태그로 되어 있는 것은 알고 있습니다만, C#으로 해결하려고 하다가 이것을 발견했습니다.@TWMIC answer와 비슷한 버전을 다음과 같이 썼습니다.
string LocalPath( string fullPath )
{
if ( fullPath.StartsWith( "https://", StringComparison.InvariantCultureIgnoreCase ) )
{
// So Documents/ location works below
fullPath = fullPath.Replace( "\\", "/" );
var userAccounts = Microsoft.Win32.Registry.CurrentUser
.OpenSubKey(@"Software\Microsoft\OneDrive\Accounts\");
if (userAccounts != null)
{
foreach (var accountName in userAccounts.GetSubKeyNames())
{
var account = userAccounts.OpenSubKey(accountName);
var endPoint = account.GetValue("ServiceEndPointUri") as string;
var userFolder = account.GetValue("UserFolder") as string;
if (!string.IsNullOrEmpty(endPoint) && !string.IsNullOrEmpty(userFolder))
{
if (endPoint.EndsWith("/_api"))
{
endPoint = endPoint.Substring(0, endPoint.Length - 4) + "documents/";
}
if (fullPath.StartsWith(endPoint, StringComparison.InvariantCultureIgnoreCase))
{
return Path.Combine(userFolder, fullPath.Substring(endPoint.Length));
}
}
}
}
}
return fullPath;
}
JK2017 코드에는 약간의 오류가 있는 것 같습니다.이러한 3가지 버전의 OneDrive를 시작할 때마다 "ShortName" 변수를 재구축해야 합니다.따라서 'i = 1 To 3' 루프 안에 있어야 합니다.또, 풀 파일명이 아닌 패스만을 취득하기 위한 선택도 추가했습니다.
Private Function Local_Workbook_Name(ByRef wb As Workbook, Optional bPathOnly As Boolean = False) As String
'returns local wb path or nothing if local path not found
Dim i As Long, x As Long
Dim OneDrivePath As String
Dim ShortName As String
Dim testWbkPath As String
Dim OneDrivePathFound As Boolean
'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
'loop through three OneDrive options
For i = 1 To 3
'Replace forward slashes with back slashes
ShortName = Replace(wb.FullName, "/", "\")
'Remove the first four backslashes
For x = 1 To 4
ShortName = RemoveTopFolderFromPath(ShortName)
Next
'Choose the version of Onedrive
OneDrivePath = Environ(Choose(i, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
If Len(OneDrivePath) > 0 Then
'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
Do While ShortName Like "*\*"
testWbkPath = OneDrivePath & "\" & ShortName
If Not (Dir(testWbkPath)) = vbNullString Then
OneDrivePathFound = True
Exit Do
End If
'remove top folder in path
ShortName = RemoveTopFolderFromPath(ShortName)
Loop
End If
If OneDrivePathFound Then Exit For
Next i
Else
If bPathOnly Then
Local_Workbook_Name = RemoveFileNameFromPath(wb.FullName)
Else
Local_Workbook_Name = wb.FullName
End If
End If
If OneDrivePathFound Then
If bPathOnly Then
Local_Workbook_Name = RemoveFileNameFromPath(testWbkPath)
Else
Local_Workbook_Name = testWbkPath
End If
End If
End Function
Function RemoveTopFolderFromPath(ByVal ShortName As String) As String
RemoveTopFolderFromPath = Mid(ShortName, InStr(ShortName, "\") + 1)
End Function
Function RemoveFileNameFromPath(ByVal ShortName As String) As String
RemoveFileNameFromPath = Mid(ShortName, 1, Len(ShortName) - InStr(StrReverse(ShortName), "\"))
End Function
슬래시 "/"의 개수가 다른 OneDrive 버전(개인용/전문용)과 관련이 있을 수 있습니다.msdn 웹사이트의 MatChrupczalski 게시물을 비교합니다.https://social.msdn.microsoft.com/Forums/en-US/1331519b-1dd1-4aa0-8f4f-0453e1647f57/how-to-get-physical-path-instead-of-url-onedrive?forum=officegeneral
그래서 저는 그 기능을 다음과 같이 수정했습니다.
Sub TestMySolution()
MsgBox ActiveWorkbook.FullName & vbCrLf & LocalFullName(ActiveWorkbook.FullName)
End Sub
' 29.03.2020 Horoman
' main parts by Philip Swannell 14.01.2019
' combined with parts from MatChrupczalski 19.05.2019
' using environment variables of OneDrive
Private Function LocalFullName(ByVal fullPath As String) As String
Dim i As Long, j As Long
Dim oneDrivePath As String
Dim endFilePath As String
Dim iDocumentsPosition As Integer
'Check if it looks like a OneDrive location
If InStr(1, fullPath, "https://", vbTextCompare) > 0 Then
'for commercial OneDrive file path seems to be like "https://companyName-my.sharepoint.com/personal/userName_domain_com/Documents" & file.FullName)
If InStr(1, fullPath, "my.sharepoint.com") <> 0 Then
'find "/Documents" in string and replace everything before the end with OneDrive local path
iDocumentsPosition = InStr(1, fullPath, "/Documents") + Len("/Documents") 'find "/Documents" position in file URL
endFilePath = Mid(fullPath, iDocumentsPosition) 'get the ending file path without pointer in OneDrive
Else
'for personal onedrive it looks like "https://d.docs.live.net/d7bbaa#######1/" & file.FullName, _
' by replacing "https.." with OneDrive local path obtained from registry we can get local file path
'Remove the first four backslashes
endFilePath = Mid(fullPath, 9) ' removes "https://" and with it two backslashes
For i = 1 To 2
endFilePath = Mid(endFilePath, InStr(endFilePath, "/") + 1)
Next
End If
'Replace forward slashes with back slashes (URL type to Windows type)
endFilePath = Replace(endFilePath, "/", Application.PathSeparator)
'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
For j = 1 To 3
oneDrivePath = Environ(Choose(j, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
If Len(oneDrivePath) > 0 Then
LocalFullName = oneDrivePath & Application.PathSeparator & endFilePath
If Dir(LocalFullName) <> "" Then
Exit Function 'that is it - WE GOT IT
End If
End If
Next j
'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
LocalFullName = ""
End If
LocalFullName = fullPath
End Function
즐겁게 보내세요.
안녕하세요, 저는 이렇게 하고 있습니다.저는 "SOFTWARE\SyncEngines\Providers\OneDrive"에서 경로를 찾았습니다.
private static string GetLocalPath(string url)
{
try
{
var oneDriveKey = Registry.CurrentUser.OpenSubKey(@"Software\SyncEngines\Providers\OneDrive");
if (oneDriveKey != null)
{
foreach (var subKeyName in oneDriveKey.GetSubKeyNames())
{
var subKey = oneDriveKey.OpenSubKey(subKeyName);
if (subKey != null)
{
var urlNameSpace = subKey.GetValue("UrlNamespace").ToString().Trim('/');
if (url.Contains(urlNameSpace) && subKey.GetValue("MountPoint") is string localLibraryPath)
{
string restOfDocumentPath = url.Substring(urlNameSpace.Length);
restOfDocumentPath = restOfDocumentPath.Replace('/', '\\');
return localLibraryPath + restOfDocumentPath;
}
}
}
}
}
catch (Exception e)
{
Console.WriteLine(e.Message);
}
return string.Empty;
}
대체 솔루션
저는 최근에 이 문제에 대한 새로운 고유한 해결책을 발견했는데, 현재 온라인 어디에도 설명되어 있지 않기 때문에 여기서 지적하고 싶습니다.
Microsoft는 최근 OneDrive 동기화 문제집을 위한 새로운 버튼을 Excel UI에 추가했습니다.
클릭하면 로컬 경로가 클립보드에 복사됩니다.이 문제에 대한 마이크로소프트의 공식 솔루션은 이번이 처음입니다.
유감스럽게도 이 기능은 오브젝트 모델의 일부가 아니기 때문에 VBA에서 이 정보를 얻으려면 코드로 버튼을 클릭해야 합니다.이것은 가능하지만 100% 신뢰할 수 있는 것은 아닙니다.그 방법의 예는 다음과 같습니다.
Public Function GetLocalPathOfWorkbook(Optional ByVal wb As Workbook = Nothing) _
As String
If wb Is Nothing Then Set wb = ThisWorkbook
GetLocalPathOfWorkbook = wb.FullName
If Not wb.FullName Like "http*" Or wb.FullName = "" Then Exit Function
With Application
Dim appScreenUpdating As Boolean: appScreenUpdating = .ScreenUpdating
Dim appEnableEvents As Boolean: appEnableEvents = .EnableEvents
Dim appDisplayAlerts As Boolean: appDisplayAlerts = .DisplayAlerts
.ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False
End With
With wb.Windows(1)
Dim wbVisible As Boolean: wbVisible = .Visible
Dim wbWindowState As XlWindowState: wbWindowState = .WindowState
If Not .Visible Then .Visible = True
If .WindowState = xlMinimized Then .WindowState = xlNormal
.Activate
End With
On Error GoTo RestoreAppState
SendKeys "%f", True 'Weirdly, both, the SendKeys and the CommandBars.Execute
SendKeys "%i", True 'are necessary for the code to run reliably, even though
'they (should) just do the same thing twice in theory?
Application.CommandBars.ExecuteMso "FileProperties"
SendKeys "%l", True
SendKeys "{ESC}", True
DoEvents
GetLocalPathOfWorkbook = _
CreateObject("HtmlFile").parentWindow.clipboardData.GetData("text")
RestoreAppState:
wb.Windows(1).WindowState = wbWindowState
wb.Windows(1).Visible = wbVisible
Application.ScreenUpdating = appScreenUpdating
Application.EnableEvents = appEnableEvents
Application.DisplayAlerts = appDisplayAlerts
If Err.Number <> 0 Then Err.Raise Err
End Function
이 는 가끔 합니다.DoEvents"코드 실행이 중단되었습니다."라는 메시지가 표시된 행.은 특히 클릭을 하기 짜증납니다.특히 클릭은Debug 다음에 또 한 번.Continue이치
에서는 「」를 사용하고 있기 에,SendKeys또한 UI 자동화는 사용자가 코드 실행 중에 앱과 상호 작용하면 예기치 않은 다른 문제를 발생시키거나 실패할 수 있습니다.외부 사용자의 조작 없이 문제가 발생할 수 있습니다.
이러한 단점을 제외하고, 이 방법은 실제로 매우 강력하며 OneDrive/SharePoint의 "웹 경로"를 로컬 경로로 가져오는 데도 사용할 수 있습니다. ("웹 경로"는 "공유 링크"가 아닌 링크입니다.)
은, 「 」가 있기 에 가능합니다.Workbook.SaveAs는 OneDrive method OneDrive URL을 합니다.따라서 로컬 경로를 찾으려면 코드를 사용하여 위치에 임시 워크북을 만들고 열고 위에서 정의한 함수를 사용하여 로컬 경로를 닫은 후 다시 삭제합니다.
다음에서는 임의 경로에 대해 이 기능이 작동함을 보여주기 위해 개념 증명을 구현했습니다(존재하는 경우에만 해당).
Public Function GetLocalPath(ByVal path As String)
GetLocalPath = path
If Not path Like "http*" Or path = "" Then Exit Function
Dim testWbName As String: testWbName = RandomStringAlphanumeric(6)
Dim wb As Workbook: Set wb = Application.Workbooks.Add
'Find out if path is a file or folder
Dim isFile As Boolean
If Not Right(path, 1) = "/" Then
On Error Resume Next
wb.SaveAs path & "/" & testWbName
If Err.Number = 1004 Then
On Error GoTo 0
wb.Saved = True 'The file that failed saving must be closed because
wb.Close SaveChanges:=xlDoNotSaveChanges 'next save attempt fails
Set wb = Nothing
isFile = True
End If
End If
If wb Is Nothing Then Set wb = Application.Workbooks.Add
'Save the test file if not already saved
On Error GoTo SaveFailed
If isFile Then
wb.SaveAs Left(path, InStrRev(path, "/")) & testWbName
ElseIf Right(path, 1) = "/" Then
wb.SaveAs path & testWbName
End If
On Error GoTo 0
'Get local path, close and delete file
Dim localTempFileFullName As String, localTempFilePath As String
localTempFileFullName = GetLocalPathOfWorkbook(wb)
localTempFilePath = Left(localTempFileFullName, InStrRev(localTempFileFullName, "\"))
wb.Saved = True
wb.Close SaveChanges:=xlDoNotSaveChanges
On Error GoTo DeleteFailed
CreateObject("Scripting.FileSystemObject").DeleteFile localTempFileFullName
On Error GoTo 0
If isFile Then
GetLocalPath = localTempFilePath & Mid(path, InStrRev(path, "/") + 1)
Else
If Right(path, 1) = "/" Then
GetLocalPath = localTempFilePath
Else
GetLocalPath = Left(localTempFilePath, Len(localTempFilePath) - 1)
End If
End If
Exit Function
SaveFailed:
If Err.Number = 1004 Then
On Error GoTo 0
wb.Saved = True
wb.Close SaveChanges:=xlDoNotSaveChanges
Exit Function
End If
Err.Raise Err
Exit Function
DeleteFailed:
MsgBox "GetLocalPath failed to get the local path of '" & path & "'" & _
vbNewLine & "A temporary file named " & testWbName & ".xlsx was " & _
"created in the location '" & path & "', please delete it manually." _
, vbCritical
Err.Raise Err.Number, "GetLocalPath", _
"Failed to delete this file: " & path & testWbName
End Function
Private Function RandomStringAlphanumeric(ByVal Length As Long) As String
Dim b() As Byte, i As Long, char As Long: Randomize
If Length < 1 Then Exit Function
ReDim b(0 To Length * 2 - 1)
For i = 0 To Length - 1
Select Case Rnd
Case Is < 0.41935: Do: char = 25 * Rnd + 65: Loop Until char <> 0
Case Is < 0.83871: Do: char = 25 * Rnd + 97: Loop Until char <> 0
Case Else: Do: char = 9 * Rnd + 48: Loop Until char <> 0
End Select
b(2 * i) = (Int(char)) And 255
Next i
RandomStringAlphanumeric = b
End Function
능력과 결론
이 방법은 레지스트리/설정 파일을 해킹하지 않고 로컬 경로를 얻는 '공식적인' 방법을 사용하고 있어 매력적으로 보이지만, 현재 이 스레드에서 허용되는 답변으로 표시된 범용 솔루션보다 신뢰성이 훨씬 떨어집니다.
가장 큰 문제는 시도된 솔루션과 관련된 UI 자동화가 대량으로 이루어지기 때문에 매우 느리고 오류가 발생하기 쉽다는 것입니다.또한 Mac에서는 백스테이지 뷰를 사용할 수 없기 때문에 동작하지 않습니다.
현시점에서는 가능한 모든 시나리오에서 범용(현재 인정되고 있는) 솔루션을 매우 선호합니다.이 솔루션의 장점은 다음과 같습니다.
- UI 자동화를 사용하지 않기 때문에 매우 빠르고 안정적으로 실행됩니다.(한 번 실행해도 이 솔루션처럼 갑자기 장애가 발생하는 일은 없습니다)
- 닫힌 파일이나 디렉토리, 존재하지 않는 파일이나 디렉토리(아직)에서도 기능합니다.
- 이 함수는 워크시트에서 호출할 수 있는 사용자 정의 함수로 작동합니다.투고부터는 '''만''입니다.
GetLocalPathOfWorkbook요, ★★★★★★★★★★★★★★★★★★★★★★」GetLocalPath지지않않않않 - MacOS에서 동작합니다.이 솔루션은 그렇지 않습니다.
- 이 솔루션은 클립보드에 영향을 주지 않습니다.
- 패스에 만, 「인터넷 접속은 필요 없습니다」라고 하는 것에 비해, 「인터넷 접속」은 필요 없습니다.
Workbook.SaveAs이 게시물에 사용된 것처럼 파일을 OneDrive에 직접 저장해야 합니다. - , 「」라고 하는 경우도 있습니다.
Workbook.SaveAs예를 들어, URL 인코딩 패스를 매우 길게 하는 불명확한 Unicode 문자가 많은 패스의 경우는 실패합니다.수용된 답변의 보편적 해결책은 그것을 다룰 수 있다.
이 방법의 기능에 대한 대략적인 이해를 돕기 위해, 여기에 제시된 테스트에서는 46개의 테스트 중 30~40개의 테스트가 올바르고 약 500초가 소요됩니다.중요한 것은 랜덤으로 발생하는 오류가 많기 때문에 사용자의 조작 없이 테스트 실행을 완료할 수 없다는 것입니다.또한 현재 항상 실패하는 테스트도 있습니다.
이 방법의 모든 결점에 비추어 볼 때, 이 짧은 해결책도 단연 선호됩니다.
할 수 있는 , 를 사용하지 .SendKeys파일 정보 섹션으로 물리적으로 이동하면 특히 이미 열려 있는 워크북에서 미래에 매우 유용할 수 있습니다.
어떻게 하면 좋을지 생각나는 사람이 있으면 알려주세요!
여기 Philip Swannell이 Virtuoso의 원래 답변을 개선한 내용이 있습니다. 경로에서 삭제하는 "\"의 수가 4개 이상일 때 또는 다른 경우(파일에 따라 5개 또는 6개를 제거해야 한다는 것을 알게 되었습니다).필립이 언급한 단점들은 여전히 거기에 있다.
Private Function Local_Workbook_Name(ByRef wb As Workbook) As String
'returns local wb path or nothing if local path not found
Dim i As Long
Dim OneDrivePath As String
Dim ShortName As String
Dim testWbkPath As String
Dim OneDrivePathFound As Boolean
'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
'Replace forward slashes with back slashes
ShortName = Replace(wb.FullName, "/", "\")
'Remove the first four backslashes
For i = 1 To 4
ShortName = RemoveTopFolderFromPath(ShortName)
Next
'loop through three OneDrive options
For i = 1 To 3
OneDrivePath = Environ(Choose(i, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
If Len(OneDrivePath) > 0 Then
'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
Do While ShortName Like "*\*"
testWbkPath = OneDrivePath & "\" & ShortName
If Not (Dir(testWbkPath)) = vbNullString Then
OneDrivePathFound = True
Exit Do
End If
'remove top folder in path
ShortName = RemoveTopFolderFromPath(ShortName)
Loop
End If
If OneDrivePathFound Then Exit For
Next i
Else
Local_Workbook_Name = wb.FullName
End If
If OneDrivePathFound Then Local_Workbook_Name = testWbkPath
End Function
Function RemoveTopFolderFromPath(ByVal ShortName As String) As String
RemoveTopFolderFromPath = Mid(ShortName, InStr(ShortName, "\") + 1)
End Function
해커라고 불러도 좋지만, 제 컴퓨터의 http 참조는 항상 같기 때문에 OneDrive를 찾을 수 있는 하드 드라이브의 로컬 참조를 조사했습니다.
를 , 그것이 ★★★★★★★★★★★★★★★★★★★★C:\MyOneDrive\OneDrive그런 다음 필요 없는 워크북 경로의 다른 부분을 모두 가져와서 로컬 부분에 추가합니다. 다음 슬래시 .
folder = "C:\MyOneDrive\OneDrive" & Right(Application.ActiveWorkbook.Path, Len(Application.ActiveWorkbook.Path) - 72) & "\"
folder = Replace(folder, "/", "\")
두 줄에 기계 케이스가 다 들어있었어요!!
모두 Windows 시스템에서 작업하는 것처럼 보이므로 파일 스크립팅 개체를 사용할 수도 있습니다.
Debug.Print
Debug.Print "ThisWorkbook.Path: "; ThisWorkbook.Path
Debug.Print "ThisWorkbook.FullName: "; ThisWorkbook.FullName
With CreateObject("Scripting.FileSystemObject")
Debug.Print "Scripting.fso: "; .GetAbsolutePathName(ThisWorkbook.Name)
End With
심볼릭 링크(mklink /d)를 만드는 문제를 해결했습니다.데스크톱 바로 가기를 통해 링크에 파일을 여는 것은 WB를 의미했습니다.FullName은 항상 심볼 링크를 사용하여 파일 경로를 반환했습니다.
VBA 없이 해결했습니다.대신 파워쿼리를 사용했습니다.
먼저 셀에서 이 공식을 사용하여 파일 이름과 워크시트 이름이 없는 경로를 가져옵니다.
=LEFT(CELL("filename";E8);FIND("[";CELL("filename";E8))-1)
그런 다음 powerquery의 테이블로 경로를 Import합니다: "Röfilsti"
다음으로 이것을 소스로 하는 다른 쿼리가 있습니다.여기서 https 파일 경로에서 데이터 처리를 수행합니다.쿼리에서 로컬 온드라이브 경로를 하드코딩했지만 온드라이브 루트 폴더를 Excel의 셀에 복사하여 붙여넣고 이를 파워쿼리에 사용할 파라미터로 호출할 수 있습니다.
그런 다음 해당 쿼리를 워크북의 테이블에 로드합니다.
언급URL : https://stackoverflow.com/questions/33734706/excels-fullname-property-with-onedrive
반응형
'programing' 카테고리의 다른 글
| 변수를 사용한 Excel vba 콜서브루틴 (0) | 2023.04.22 |
|---|---|
| Azure WebApp URL 이름을 변경하는 방법 (0) | 2023.04.22 |
| WPF 데이터 바인딩 및 검증 규칙의 베스트프랙티스 (0) | 2023.04.22 |
| 설정에 정의된 값에 바인딩 (0) | 2023.04.22 |
| 표준 VBA 기능을 위한 "프로젝트 또는 라이브러리를 찾을 수 없습니다" (0) | 2023.04.22 |