Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Скачать (Сохранить) файл с Яндекс-диска макросом Excel - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скачать (Сохранить) файл с Яндекс-диска макросом Excel (Макросы/Sub)
Скачать (Сохранить) файл с Яндекс-диска макросом Excel
Pelena Дата: Понедельник, 05.12.2016, 22:18 | Сообщение № 1
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Приветствую всех!
Друзья, помогите советом, как можно (и можно ли вообще) обратиться к папке, созданной на Яндекс-диске, из макроса книги Excel? Есть ли возможность как-то прописать путь к такой папке, скачать из неё файлы, а потом после обработки сохранить в ту же папку под другим именем?

Подробнее: есть проект, в котором открывается шаблон Excel (.xlt), соответственно, создаётся новая книга, в ней заполняются данные, отрабатывают разные макросы, в том числе, создаются документы Word на основе опять-таки шаблонов (.dot) и сохраняются в отдельную папку. Проект рабочий, но у клиента возникла идея хранить шаблоны и сформированные документы на Яндекс-диске.
Хотелось бы услышать ваше мнение об этой идее, насколько она вообще реализуема?
Пришла к выводу, что непосредственно запускать шаблоны с Яндекса не получится. То есть надо скачивать куда-то во временную папку. Но как??!!
[p.s.]Если нужны файлы, могу сочинить примеры[/p.s.]


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеПриветствую всех!
Друзья, помогите советом, как можно (и можно ли вообще) обратиться к папке, созданной на Яндекс-диске, из макроса книги Excel? Есть ли возможность как-то прописать путь к такой папке, скачать из неё файлы, а потом после обработки сохранить в ту же папку под другим именем?

Подробнее: есть проект, в котором открывается шаблон Excel (.xlt), соответственно, создаётся новая книга, в ней заполняются данные, отрабатывают разные макросы, в том числе, создаются документы Word на основе опять-таки шаблонов (.dot) и сохраняются в отдельную папку. Проект рабочий, но у клиента возникла идея хранить шаблоны и сформированные документы на Яндекс-диске.
Хотелось бы услышать ваше мнение об этой идее, насколько она вообще реализуема?
Пришла к выводу, что непосредственно запускать шаблоны с Яндекса не получится. То есть надо скачивать куда-то во временную папку. Но как??!!
[p.s.]Если нужны файлы, могу сочинить примеры[/p.s.]

Автор - Pelena
Дата добавления - 05.12.2016 в 22:18
Саня Дата: Понедельник, 05.12.2016, 23:37 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 1068
Репутация: 560 ±
Замечаний: 0% ±

XL 2016
Привет!

Единственное, что пришло ...

прога синхронизирует я.диск с заданной папкой на компе
 
Ответить
СообщениеПривет!

Единственное, что пришло ...

прога синхронизирует я.диск с заданной папкой на компе

Автор - Саня
Дата добавления - 05.12.2016 в 23:37
doober Дата: Понедельник, 05.12.2016, 23:48 | Сообщение № 3
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте Елена.
Но как??!!

Элементарно Ватсон.
так получаем ссылку на файл для закачки.С обратной операцией дела не имел.
[vba]
Код
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
[/vba]


 
Ответить
СообщениеЗдравствуйте Елена.
Но как??!!

Элементарно Ватсон.
так получаем ссылку на файл для закачки.С обратной операцией дела не имел.
[vba]
Код
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
[/vba]

Автор - doober
Дата добавления - 05.12.2016 в 23:48
Pelena Дата: Вторник, 06.12.2016, 00:03 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Саня, Сергей, спасибо за ответы. Испробую оба варианта yes


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеСаня, Сергей, спасибо за ответы. Испробую оба варианта yes

Автор - Pelena
Дата добавления - 06.12.2016 в 00:03
krosav4ig Дата: Вторник, 06.12.2016, 02:10 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте.
можно подключить ЯДиск как сетевой диск
windows
Mac OS


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте.
можно подключить ЯДиск как сетевой диск
windows
Mac OS

Автор - krosav4ig
Дата добавления - 06.12.2016 в 02:10
Pelena Дата: Вторник, 06.12.2016, 09:34 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Андрей, спасибо за ответ. Была мысль о сетевом диске, но не сообразила, как обратиться к Яндексу. Следуя инструкциям по ссылке, сетевой диск создала. Но почему-то не удаётся использовать путь Z:\ в макросе, вернее, не всегда удаётся, буду ещё экспериментировать.

Саня, твой вариант тоже попробовала, установила программу, в общем понравилось, путь прописывается в макросе, как обычно, всё запускается, создаётся, сохраняется, причём достаточно быстро. И папку можно сделать общедоступной при необходимости. Спасибо!

Сергей, с помощью Вашего макроса у меня получилось закачать файл с Яндекс-диска, спасибо! Не знаю только вот, как отправить созданные документы обратно :(

Сегодня пообщаюсь с клиентом, обрисую ситуацию, пусть решает, может ещё передумает)
Ещё раз всем большое спасибо!


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеАндрей, спасибо за ответ. Была мысль о сетевом диске, но не сообразила, как обратиться к Яндексу. Следуя инструкциям по ссылке, сетевой диск создала. Но почему-то не удаётся использовать путь Z:\ в макросе, вернее, не всегда удаётся, буду ещё экспериментировать.

Саня, твой вариант тоже попробовала, установила программу, в общем понравилось, путь прописывается в макросе, как обычно, всё запускается, создаётся, сохраняется, причём достаточно быстро. И папку можно сделать общедоступной при необходимости. Спасибо!

Сергей, с помощью Вашего макроса у меня получилось закачать файл с Яндекс-диска, спасибо! Не знаю только вот, как отправить созданные документы обратно :(

Сегодня пообщаюсь с клиентом, обрисую ситуацию, пусть решает, может ещё передумает)
Ещё раз всем большое спасибо!

Автор - Pelena
Дата добавления - 06.12.2016 в 09:34
_Boroda_ Дата: Вторник, 06.12.2016, 09:56 | Сообщение № 7
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16672
Репутация: 6479 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Но почему-то не удаётся использовать путь Z:\

У меня на работе иногда тоже не ловится прямая ссылка на z (у меня он не z, а f) - f:\Дальше_какой-то_путь
А вот так всегда работает -
вставить гиперссылкой путь f:\Дальше_какой-то_путь, пройти по этой ГС - откроется Проводник и в нем уже в пути (наверху который пишется) вместо f пишется нормальное название этого диска. Вот его и копируем


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
Но почему-то не удаётся использовать путь Z:\

У меня на работе иногда тоже не ловится прямая ссылка на z (у меня он не z, а f) - f:\Дальше_какой-то_путь
А вот так всегда работает -
вставить гиперссылкой путь f:\Дальше_какой-то_путь, пройти по этой ГС - откроется Проводник и в нем уже в пути (наверху который пишется) вместо f пишется нормальное название этого диска. Вот его и копируем

Автор - _Boroda_
Дата добавления - 06.12.2016 в 09:56
Pelena Дата: Вторник, 06.12.2016, 10:41 | Сообщение № 8
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Спасибо, Саш.
Но всё равно не получается создать документ на основе шаблона из вложенной папки templates. Хотя путь вроде видит, создаёт по нему папку, сохраняет в ней файл. Видимо, это уже дело не в пути, а в чём-то другом. Будем искать)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеСпасибо, Саш.
Но всё равно не получается создать документ на основе шаблона из вложенной папки templates. Хотя путь вроде видит, создаёт по нему папку, сохраняет в ней файл. Видимо, это уже дело не в пути, а в чём-то другом. Будем искать)

Автор - Pelena
Дата добавления - 06.12.2016 в 10:41
Alex_ST Дата: Среда, 07.12.2016, 09:28 | Сообщение № 9
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3206
Репутация: 609 ±
Замечаний: 0% ±

2003
Ребята, может быть я что-то в ТЗ не понял, но почему нельзя использовать синхронизацию ЯД с локальной директорией на своём компе?
А нужную папку на ЯД расшарьте для конкретных пользователей.
И работайте спокойно с файлами на своём компе. Создавайте/удаляйте файлы, папки… Всё, что Вы сделаете у себя, отзеркалится на ЯД.
В чём проблема-то? Зачем брать файл с ЯД, когда можно юзать его локальную копию?



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
СообщениеРебята, может быть я что-то в ТЗ не понял, но почему нельзя использовать синхронизацию ЯД с локальной директорией на своём компе?
А нужную папку на ЯД расшарьте для конкретных пользователей.
И работайте спокойно с файлами на своём компе. Создавайте/удаляйте файлы, папки… Всё, что Вы сделаете у себя, отзеркалится на ЯД.
В чём проблема-то? Зачем брать файл с ЯД, когда можно юзать его локальную копию?

Автор - Alex_ST
Дата добавления - 07.12.2016 в 09:28
Pelena Дата: Среда, 07.12.2016, 09:32 | Сообщение № 10
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Собственно, Саня во втором посте это и предложил


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеСобственно, Саня во втором посте это и предложил

Автор - Pelena
Дата добавления - 07.12.2016 в 09:32
Alex_ST Дата: Среда, 07.12.2016, 09:48 | Сообщение № 11
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3206
Репутация: 609 ±
Замечаний: 0% ±

2003
И, к стати, юзая одновременно на работе и дома Гугл.Диск (на Я.Д Мэйл.Диск и Дропбокс с работы не пускают собаки-сисадмины), я часто использую очень удобную штуку - Link Shell Extension
Это расширение позволяет создавать в Форточках симлинки, аналогичные Линуксово-Андроидным.
Для тех файлов, с которыми мне удобно работать на компе в одной директории, а реально они разбросаны по многим папкам, включая и сетевые, я просто создаю симлинки и кладу их все в одну папочку.
Комп будет думать, что работает с файлами, лежащими в этой папке, а физически они могут быть разбросаны где угодно.
Я через симлинки даже пытался зеркалить файлы с ГД на МД через домашний комп. Результат, к сожалению, не стабильный - некоторые файлы зеркалятся в Облако, а некоторые нет (М.Д почему-то сильно озадачивается, пытаясь скопировать к себе в Облако файл с моего компа по некоторым симлинкам, а некоторые глотает спокойно)



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
СообщениеИ, к стати, юзая одновременно на работе и дома Гугл.Диск (на Я.Д Мэйл.Диск и Дропбокс с работы не пускают собаки-сисадмины), я часто использую очень удобную штуку - Link Shell Extension
Это расширение позволяет создавать в Форточках симлинки, аналогичные Линуксово-Андроидным.
Для тех файлов, с которыми мне удобно работать на компе в одной директории, а реально они разбросаны по многим папкам, включая и сетевые, я просто создаю симлинки и кладу их все в одну папочку.
Комп будет думать, что работает с файлами, лежащими в этой папке, а физически они могут быть разбросаны где угодно.
Я через симлинки даже пытался зеркалить файлы с ГД на МД через домашний комп. Результат, к сожалению, не стабильный - некоторые файлы зеркалятся в Облако, а некоторые нет (М.Д почему-то сильно озадачивается, пытаясь скопировать к себе в Облако файл с моего компа по некоторым симлинкам, а некоторые глотает спокойно)

Автор - Alex_ST
Дата добавления - 07.12.2016 в 09:48
Alex_ST Дата: Среда, 07.12.2016, 09:51 | Сообщение № 12
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3206
Репутация: 609 ±
Замечаний: 0% ±

2003
Собственно, Саня во втором посте это и предложил
Каюсь, не внимательно читал, по Саниной ссылке не пошёл... :(



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
Сообщение
Собственно, Саня во втором посте это и предложил
Каюсь, не внимательно читал, по Саниной ссылке не пошёл... :(

Автор - Alex_ST
Дата добавления - 07.12.2016 в 09:51
krosav4ig Дата: Среда, 07.12.2016, 13:46 | Сообщение № 13
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Нарисовал функции для скачивания/выгрузки на ЯДиск
скачивание проходит нормально, а вот с выгрузкой чего-то не так. В корень вообще не загружает, в папки грузит мягко говоря, через раз, может чего лишнего понаписал или не те объекты использовал
[vba]
Код
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
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Среда, 07.12.2016, 13:47
 
Ответить
СообщениеНарисовал функции для скачивания/выгрузки на ЯДиск
скачивание проходит нормально, а вот с выгрузкой чего-то не так. В корень вообще не загружает, в папки грузит мягко говоря, через раз, может чего лишнего понаписал или не те объекты использовал
[vba]
Код
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
[/vba]

Автор - krosav4ig
Дата добавления - 07.12.2016 в 13:46
Pelena Дата: Среда, 07.12.2016, 14:00 | Сообщение № 14
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Андрей, спасибо. Протестирую ближе к вечеру


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеАндрей, спасибо. Протестирую ближе к вечеру

Автор - Pelena
Дата добавления - 07.12.2016 в 14:00
Pelena Дата: Среда, 07.12.2016, 22:02 | Сообщение № 15
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Как же всё сложно :'(
Моих способностей хватило только скопировать этот код и запустить.
Скачать и открыть получается, а при сохранении ошибка загрузки указанного контента на строке
[vba]
Код
.send FileContents
[/vba]
:(
Думаю всё-таки остановиться на варианте с синхронизацией папок


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеКак же всё сложно :'(
Моих способностей хватило только скопировать этот код и запустить.
Скачать и открыть получается, а при сохранении ошибка загрузки указанного контента на строке
[vba]
Код
.send FileContents
[/vba]
:(
Думаю всё-таки остановиться на варианте с синхронизацией папок

Автор - Pelena
Дата добавления - 07.12.2016 в 22:02
Alex_ST Дата: Среда, 07.12.2016, 22:21 | Сообщение № 16
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3206
Репутация: 609 ±
Замечаний: 0% ±

2003
Или попробовать по WEBDAV подключить как советовал krosav4ig
можно подключить ЯДиск как сетевой диск windows
Хотя далеко не факт, что получится.
Я где-то с год-полтора назад в последний раз пробовал - не вышло. Потом погуглил и нашёл кучу ругани юзеров, что в бесплатных Облаках их владельцы объявляют возможность коннекта по WEBDAV , а реально это нигде не работает, т.к. тогда они потеряют на рекламе.
Но попытка не пытка. Удачи!



С уважением,
Алексей
MS Excel 2003 - the best!!!
 
Ответить
СообщениеИли попробовать по WEBDAV подключить как советовал krosav4ig
можно подключить ЯДиск как сетевой диск windows
Хотя далеко не факт, что получится.
Я где-то с год-полтора назад в последний раз пробовал - не вышло. Потом погуглил и нашёл кучу ругани юзеров, что в бесплатных Облаках их владельцы объявляют возможность коннекта по WEBDAV , а реально это нигде не работает, т.к. тогда они потеряют на рекламе.
Но попытка не пытка. Удачи!

Автор - Alex_ST
Дата добавления - 07.12.2016 в 22:21
krosav4ig Дата: Четверг, 08.12.2016, 01:10 | Сообщение № 17
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
ошибка загрузки указанного контента

печалько :(
кстати, можно прямо в VBA подключать нужную папку ЯДиска
[vba]
Код
CreateObject("WScript.Network").MapNetworkDrive "W:", "https://webdav.yandex.ru:443/Документы/Клиент/Templates", False, "Login", "Password"
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
ошибка загрузки указанного контента

печалько :(
кстати, можно прямо в VBA подключать нужную папку ЯДиска
[vba]
Код
CreateObject("WScript.Network").MapNetworkDrive "W:", "https://webdav.yandex.ru:443/Документы/Клиент/Templates", False, "Login", "Password"
[/vba]

Автор - krosav4ig
Дата добавления - 08.12.2016 в 01:10
krosav4ig Дата: Пятница, 09.12.2016, 09:55 | Сообщение № 18
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Исправил свой код, так должно работать
[vba]
Код
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
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Пятница, 09.12.2016, 14:00
 
Ответить
СообщениеИсправил свой код, так должно работать
[vba]
Код
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
[/vba]

Автор - krosav4ig
Дата добавления - 09.12.2016 в 09:55
Pelena Дата: Пятница, 09.12.2016, 11:08 | Сообщение № 19
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Андрей, браво!!! Ты всё-таки это сделал!
Вот на этой строчке споткнулся
[vba]
Код
Dim dd As WinHttpRequest
[/vba]
убрала, заработало. Вроде, лишняя (?)

Может, оформить Готовым решением?


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеАндрей, браво!!! Ты всё-таки это сделал!
Вот на этой строчке споткнулся
[vba]
Код
Dim dd As WinHttpRequest
[/vba]
убрала, заработало. Вроде, лишняя (?)

Может, оформить Готовым решением?

Автор - Pelena
Дата добавления - 09.12.2016 в 11:08
krosav4ig Дата: Пятница, 09.12.2016, 11:48 | Сообщение № 20
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Вроде, лишняя
Вроде, лишняя (?)

ага, как-то сама затесалась #этнияоносамо :)
Может, оформить Готовым решением?

может быть, но, чтобы решение было прям совсем готовое, нужно (имхо) его дополнить проверками на ошибки и хоть немного откомментировать, а на это у мну сейчас времени немного не хватает :(


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеВроде, лишняя
Вроде, лишняя (?)

ага, как-то сама затесалась #этнияоносамо :)
Может, оформить Готовым решением?

может быть, но, чтобы решение было прям совсем готовое, нужно (имхо) его дополнить проверками на ошибки и хоть немного откомментировать, а на это у мну сейчас времени немного не хватает :(

Автор - krosav4ig
Дата добавления - 09.12.2016 в 11:48
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скачать (Сохранить) файл с Яндекс-диска макросом Excel (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!