Function GetyanURU() As String
    Dim RRz As String
    GetyanURU = ""
    UU = "https://yadi.sk/i/W-RyKT4o32K3PG"
    UU = Replace(UU, "/", "%2F")
    UU = Replace(UU, ":", "%3A")
    url = "https://cloud-api.yandex.net/v1/disk/public/resources/download?public_key=" & UU
    On Error Resume Next
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    With oXMLHTTP
        .Open "GET", url, False
        .send
        sHTML = .responseText
        Set RegExp = CreateObject("VBScript.RegExp")
        RegExp.Pattern = Chr(34) & "(https(.+?))" & Chr(34)

        Set oMatches = RegExp.Execute(sHTML)
        If oMatches.Count > 0 Then
            GetyanURU = oMatches(0).subMatches(0)
        End If
    End With
    Set oXMLHTTP = Nothing
End Function

Private Const Login$ = "Логин", Pwd$ = "Пароль"
Private Const Host$ = "https://webdav.yandex.ru:443/"
Public Function DownloadFile(RemoteFilePath$, SaveTo$)
    Dim FileContents() As Byte, LocalFilePath$
    SaveTo = IIf(Right(SaveTo, 1) = "\", SaveTo, SaveTo & "\")
    With CreateObject("MSXML2.XMLHTTP")
        .Open "get", urlencode(Host & RemoteFilePath), False, Login, Pwd
        .setrequestheader "Host", "webdav.yandex.ru"
        .setrequestheader "Accept", "*/*"
        .setrequestheader "Authorization", "Basic " & Token
        .send
        FileContents = .responseBody
    End With
    LocalFilePath = SaveTo & StrReverse(Split(StrReverse(RemoteFilePath), "/")(0))
    If Dir(LocalFilePath) <> "" Then Kill LocalFilePath
    Open LocalFilePath For Binary Access Write As #1
    Put #1, 1, FileContents
    Close #1
    DownloadFile = LocalFilePath
End Function
Public Sub UploadFile(LocalFilePath$, RemotePath$)
    Dim FileContents As Variant, FileName$
    FileName = StrReverse(Split(StrReverse(LocalFilePath), "\")(0))
    RemotePath = IIf(RemotePath <> "", RemotePath & "/", "")
    With CreateObject("ADODB.Stream")
        .Type = 1: .Open: .LoadFromFile LocalFilePath: FileContents = .Read: .Close
    End With
    With CreateObject("MSXML2.XMLHTTP")
        .Open "put", urlencode(Host & RemotePath & FileName), False, Login, Pwd
        .setrequestheader "Host", "webdav.yandex.ru"
        .setrequestheader "Accept", "*/*"
        .setrequestheader "Transfer-Encoding", "chunked"
        .setrequestheader "Etag", MD5(FileContents)
        .setrequestheader "Sha256", Sha256(FileContents)
        .setrequestheader "Expect", "100-continue"
        .setrequestheader "Content-Type", "application/binary"
        .setrequestheader "Authorization", "Basic " & Token
        .setrequestheader "Content-Length", UBound(FileContents) + 1
        .send FileContents
    End With
End Sub
Private Function Str2Byte(str$) As Byte()
    Str2Byte = StrConv(str, vbFromUnicode)
End Function
Private Function urlencode$(url$)
    With CreateObject("scriptcontrol")
        .Language = "JavaScript"
        urlencode = .eval("encodeURI('" & url & "')")
    End With
End Function
Private Function MD5(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    MD5 = sTmp
End Function
Private Function Sha256(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.SHA256Managed")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    Sha256 = sTmp
End Function
Private Function Token()
    With CreateObject("MSXML2.DOMDocument").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = Str2Byte(Login): Token = .Text & ":"
        .nodeTypedValue = Str2Byte(Pwd): Token = Token & .Text
    End With
End Function

Sub test()
    'открываем файл из папки 111 в ЯДиске
    Workbooks.Open DownloadFile("123/1.xlsm", "D:\")
    'открываем файл из корня ЯДиска
    Workbooks.Open DownloadFile("123.xlsx", Environ("tmp"))
    'выгружаем файл в папку 123 в ЯДиске
    UploadFile "D:\0.xlsm", "123"
    'выгружаем файл в корень в ЯДиска    не грузит
    UploadFile "D:\0.xlsm", ""
End Sub

.send FileContents

CreateObject("WScript.Network").MapNetworkDrive "W:", "https://webdav.yandex.ru:443/Документы/Клиент/Templates", False, "Login", "Password"

Private Const Login$ = "Логин", Pwd$ = "Пароль"
Private Const Host$ = "https://webdav.yandex.ru:443/"
Public Function DownloadFile(RemoteFilePath$, SaveTo)
    Dim FileContents() As Byte, LocalFilePath$
    SaveTo = IIf(Right(SaveTo, 1) = "\", SaveTo, SaveTo & "\")
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", urlencode(Host & RemoteFilePath$), True
        .SetRequestHeader "Host", "webdav.yandex.ru"
        .SetRequestHeader "Accept", "*/*"
        .SetRequestHeader "Authorization", "Basic " & Token
        .send
        .WaitForResponse
        FileContents = .responseBody
    End With
    LocalFilePath = SaveTo & StrReverse(Split(StrReverse(RemoteFilePath), "/")(0))
    If Dir(LocalFilePath) <> "" Then Kill LocalFilePath
    Open LocalFilePath For Binary Access Write As #1
    Put #1, 1, FileContents
    Close #1
    DownloadFile = LocalFilePath
End Function
Public Sub UploadFile(LocalFilePath$, RemotePath$)
    Dim FileContents As Variant, FileName$
    FileName = StrReverse(Split(StrReverse(LocalFilePath), "\")(0))
    RemotePath = IIf(RemotePath <> "", RemotePath & "/", "")
    With CreateObject("ADODB.Stream")
        .Type = 1: .Open: .LoadFromFile LocalFilePath: FileContents = .Read: .Close
    End With
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "PUT", urlencode(Host & RemotePath & FileName), False
        .SetRequestHeader "Host", "webdav.yandex.ru"
        .SetRequestHeader "Accept", "*/*"
        .SetRequestHeader "Etag", MD5(FileContents)
        .SetRequestHeader "Sha256", Sha256(FileContents)
        .SetRequestHeader "Expect", "100-continue"
        .SetRequestHeader "Content-Type", "application/binary"
        .SetRequestHeader "Authorization", "Basic " & Token
        .SetRequestHeader "Content-Length", UBound(FileContents) + 1
        .send FileContents
        .WaitForResponse
        Debug.Print "Файл "; IIf(.StatusText = "Created", "успешно загружен", "не загружен")
    End With
End Sub
Private Function Str2Byte(str$) As Byte()
    Str2Byte = StrConv(str, vbFromUnicode)
End Function
Private Function urlencode$(url$)
    With CreateObject("scriptcontrol")
        .Language = "JavaScript"
        urlencode = .eval("encodeURI('" & url & "')")
    End With
End Function
Private Function MD5(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    MD5 = sTmp
End Function
Private Function Sha256(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.SHA256Managed")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    Sha256 = sTmp
End Function
Private Function Token()
    With CreateObject("MSXML2.DOMDocument").createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = Str2Byte(Login & ":" & Pwd): Token = .Text
    End With
End Function

Dim dd As WinHttpRequest

Dim dd