Лена, не надо подавать плохой пример начинающим. Если не знаешь точно размерности или необходимо раннее связывание, лучше уж не удалять определение переменной (терпеть не могу работать без Option Explicit ), а просто определить As Variant [vba]
Код
Dim dd
[/vba]
Лена, не надо подавать плохой пример начинающим. Если не знаешь точно размерности или необходимо раннее связывание, лучше уж не удалять определение переменной (терпеть не могу работать без Option Explicit ), а просто определить As Variant [vba]
То это однозначно говорит о том, что в референсах семейство не объявлено. Ну а возможность объявления лишних переменных, да ещё таких, для которых необходимо раннее связывание, таким продвинутым программером (без всякой иронии), как krosav4ig, я просто не учёл... Прошу пардону...
Честно говоря, код не разбирал. Но если пользователь говорит, что
То это однозначно говорит о том, что в референсах семейство не объявлено. Ну а возможность объявления лишних переменных, да ещё таких, для которых необходимо раннее связывание, таким продвинутым программером (без всякой иронии), как krosav4ig, я просто не учёл... Прошу пардону...Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Пятница, 09.12.2016, 13:22
Эт я просто забыл, каким методом логин/пароль задавать, вот и решил посмотреть (на всякий случай, вдруг в проксю упрется). В MSDN лезть лень, добавил референс, зачем-то обьявил переменную, полез в object explorer, поковырялся там, нашел SetCredentials, но не нашел никакой инфы про HTTPREQUEST_SETCREDENTIALS_FLAGS, все равно пришлось лезть в MSDN, референс отключил, а переменную затереть забыл
Эт я просто забыл, каким методом логин/пароль задавать, вот и решил посмотреть (на всякий случай, вдруг в проксю упрется). В MSDN лезть лень, добавил референс, зачем-то обьявил переменную, полез в object explorer, поковырялся там, нашел SetCredentials, но не нашел никакой инфы про HTTPREQUEST_SETCREDENTIALS_FLAGS, все равно пришлось лезть в MSDN, референс отключил, а переменную затереть забыл krosav4ig
Уважаемый Андрей, долго гуглил необходимое решение и о! чудо, нашел ваш пост! )) Счастью было так рядом, но к сожалению код не работает из под х64. Спотыкается на строке "With CreateObject("scriptcontrol")" с ошибкой - Run-time error 429, ActiveX componentcan't create object. Не подскажете что необходимо изменить в вашем коде?
(у меня win10 x64, Office 365)
Буду очень вам благодарен за ваш опыт и знания! С уважением, Сергей
Уважаемый Андрей, долго гуглил необходимое решение и о! чудо, нашел ваш пост! )) Счастью было так рядом, но к сожалению код не работает из под х64. Спотыкается на строке "With CreateObject("scriptcontrol")" с ошибкой - Run-time error 429, ActiveX componentcan't create object. Не подскажете что необходимо изменить в вашем коде?
(у меня win10 x64, Office 365)
Буду очень вам благодарен за ваш опыт и знания! С уважением, СергейSergSK
Не подскажете что необходимо изменить в вашем коде?
Скорее всего это связано с отсутствием необходимой dll в системе. Необходимой для scriptcontrol. Это уже обсуждалось на форуме, но сейчас ссылок не найду. В атаче сама dll-ка и тхт файл. Там можно посмотреть как регистрировать. Только ее надо в папку скопировать c:\Windows\System32\ К библиотеке экзешник идет, который регистрацию сам делает, но с ним размерчик большой выходит.
Не подскажете что необходимо изменить в вашем коде?
Скорее всего это связано с отсутствием необходимой dll в системе. Необходимой для scriptcontrol. Это уже обсуждалось на форуме, но сейчас ссылок не найду. В атаче сама dll-ка и тхт файл. Там можно посмотреть как регистрировать. Только ее надо в папку скопировать c:\Windows\System32\ К библиотеке экзешник идет, который регистрацию сам делает, но с ним размерчик большой выходит.Udik
Подключите Яндексдиск с помощью программы NetDrive, все отлично работает, можно работать как с обычным диском, в отличие от сетевого. Учтите, что подключенный диск долго соображает при сохранении.
Подключите Яндексдиск с помощью программы NetDrive, все отлично работает, можно работать как с обычным диском, в отличие от сетевого. Учтите, что подключенный диск долго соображает при сохранении.Starbirst
Сообщение отредактировал Starbirst - Пятница, 15.12.2017, 21:55
Подключите Яндексдиск с помощью программы NetDrive, все отлично работает, можно работать как с обычным диском, в отличие от сетевого. Учтите, что подключенный диск долго соображает при сохранении.
Зачем использовать платный инструмент???
[vba]
Код
Function WebDavDsk(lgn$, psw$, Optional fldr$) As String Dim fso As Object, netDsk As Object, dskPath$, i& Set netDsk = CreateObject("WScript.Network") Set fso = CreateObject("Scripting.FileSystemObject") On Error Resume Next For i = 65 To 90 dskPath = Chr(i) & ":" If Not fso.DriveExists(dskPath) Then netDsk.MapNetworkDrive dskPath, "https://webdav.yandex.ru:443/" & fldr, False, lgn, psw If Err.Number = 0 Then Exit For Else dskPath = "": Err.Clear End If Next On Error GoTo 0 WebDavDsk = dskPath End Function
Sub NetDskOff(dskPath$) Dim fso As Object, x, netDsk As Object Set fso = CreateObject("Scripting.FileSystemObject") Set netDsk = CreateObject("WScript.Network") On Error Resume Next For Each x In fso.Drives dskPath = x.Path: If fso.FolderExists(dskPath) Then netDsk.RemoveNetworkDrive dskPath, True, True: Exit For Next End Sub
Sub ПримерИспользования() Dim БукваПодключаемогоДиска$ БукваПодключаемогоДиска = WebDavDsk("Логин", "Пароль", "Папка") 'vcomp71 написал: Загрузить файл, скачать, создать директорию, переименовать 'Здесь все это делаем что хотели
NetDskOff БукваПодключаемогоДиска 'Отключаем диск после работы
Подключите Яндексдиск с помощью программы NetDrive, все отлично работает, можно работать как с обычным диском, в отличие от сетевого. Учтите, что подключенный диск долго соображает при сохранении.
Зачем использовать платный инструмент???
[vba]
Код
Function WebDavDsk(lgn$, psw$, Optional fldr$) As String Dim fso As Object, netDsk As Object, dskPath$, i& Set netDsk = CreateObject("WScript.Network") Set fso = CreateObject("Scripting.FileSystemObject") On Error Resume Next For i = 65 To 90 dskPath = Chr(i) & ":" If Not fso.DriveExists(dskPath) Then netDsk.MapNetworkDrive dskPath, "https://webdav.yandex.ru:443/" & fldr, False, lgn, psw If Err.Number = 0 Then Exit For Else dskPath = "": Err.Clear End If Next On Error GoTo 0 WebDavDsk = dskPath End Function
Sub NetDskOff(dskPath$) Dim fso As Object, x, netDsk As Object Set fso = CreateObject("Scripting.FileSystemObject") Set netDsk = CreateObject("WScript.Network") On Error Resume Next For Each x In fso.Drives dskPath = x.Path: If fso.FolderExists(dskPath) Then netDsk.RemoveNetworkDrive dskPath, True, True: Exit For Next End Sub
Sub ПримерИспользования() Dim БукваПодключаемогоДиска$ БукваПодключаемогоДиска = WebDavDsk("Логин", "Пароль", "Папка") 'vcomp71 написал: Загрузить файл, скачать, создать директорию, переименовать 'Здесь все это делаем что хотели
NetDskOff БукваПодключаемогоДиска 'Отключаем диск после работы
У меня совсем другой вопрос. Такой способ, с подключением сетевого диска, слишком много занимает времени. Я попробовал запустить представленный код, сервер ответил .StatusText = Conflict Вот процедура попытки загрузить в коренную папку
[vba]
Код
Sub Пример() UploadFile "c:\#work\777(minus).mp3", "777.mp3"
End Sub
[/vba] 1. Файл на локальном диске существует 2. Вручную загружается 3. На облачном диске такого файла нет.
У меня совсем другой вопрос. Такой способ, с подключением сетевого диска, слишком много занимает времени. Я попробовал запустить представленный код, сервер ответил .StatusText = Conflict Вот процедура попытки загрузить в коренную папку
[vba]
Код
Sub Пример() UploadFile "c:\#work\777(minus).mp3", "777.mp3"
End Sub
[/vba] 1. Файл на локальном диске существует 2. Вручную загружается 3. На облачном диске такого файла нет.vcomp71
Если VBA написать русскими буквами, то получится МИФ.
vcomp71, Вы смотрели решения из этой темы? Не подходят?
Вот как раз решением из этой темы я и воспользовался. Что-то последнеен время я корявао формулирую. Конечно же код был взять из данной темы. Поэтому и пишу. Решение с подключением сетевого диска прекрасно работает, но это не совсем то.
vcomp71, Вы смотрели решения из этой темы? Не подходят?
Вот как раз решением из этой темы я и воспользовался. Что-то последнеен время я корявао формулирую. Конечно же код был взять из данной темы. Поэтому и пишу. Решение с подключением сетевого диска прекрасно работает, но это не совсем то.vcomp71
Если VBA написать русскими буквами, то получится МИФ.
В Сообщение № 27 Пользователь Starbirst предложил решение задачи сформилированное в названии как " Скачать (Сохранить) файл с Яндекс-диска макросом Excel (Макросы/Sub)"
Цитата
Подключите Яндексдиск с помощью программы NetDrive, все отлично работает, можно работать как с обычным диском, в отличие от сетевого. Учтите, что подключенный диск долго соображает при сохранении.
Данное решение задачи не отвечает нескольким условиям. В частности: 1) NetDrive - платная программа 2) Занимает системные ресурсы (одну из букв сетевых дисков) 3) Загрузка может происходить на несколько облачных дисвков в одной программе
В своем Сообщение № 28 я привел пример макроса, который подключает сетевой диск Yandex диска, а потом отключает, но данное решениеимеет один мнус -время коннекта к диску слишком большое. Поэтому я воспользовался решением представленным в сообщении Сообщение № 18.
В качетве параметров
LocalFilePath$ RemotePath$
проиведнноой в Сообщение № 18 процедуры UploadFile(LocalFilePath$, RemotePath$)
[vba]
Код
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
[/vba]
Я взял следующие параметры LocalFilePath$ = "c:\#work\777(minus).mp3" RemotePath$ = "777.mp3"
Запустил пример, для закачивания фала в облако, преварительно изменив процедуру upload, чтобы выснить ответ, который дает сервер. [vba]
Код
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 .StatusText End With End Sub
[/vba]
Debug.Print .StatusText - чтобы получить ответ сервера. Ответ сервера .StatusText = "Conflict"
То есть используя код, приведенный в Сообщении 18, я получил отклик сервера о неком конфликте файлов (или конфликте имен файло), и загрузка файла в облако не произошла. Я задал вопрос:
Я попробовал запустить представленный код, сервер ответил .StatusText = Conflict Вот процедура попытки загрузить в коренную папку [vba]
Код
Sub Пример() UploadFile "c:\#work\777(minus).mp3", "777.mp3"
End Sub
[/vba]
Далее я написал исходные условия загрузки файла
1. Файл на локальном диске существует 2. Вручную загружается 3. На облачном диске такого файла нет.
Чтобы исключть, как мне кажется, возможные ошибки и ненужные рассуждения на темы:
1. "А у вас файл присуствовует на локальном диске по заданному пути?" 2. "А вы свой файл вручную загружать на яндекс диск пробовали и успешно?" 3. "А у вас такой файл уже есть в корневом каталоге обласного диска?"
Еще раз задаю вопрос: что может значить значение ответа сервера Яндекс Диска:
.StatusText = "Conflict" и отрицательный результат работы процедуры по загрузке файла Upload из сообщения 18 (файл на облачный диск не закгружен).
В Сообщение № 27 Пользователь Starbirst предложил решение задачи сформилированное в названии как " Скачать (Сохранить) файл с Яндекс-диска макросом Excel (Макросы/Sub)"
Цитата
Подключите Яндексдиск с помощью программы NetDrive, все отлично работает, можно работать как с обычным диском, в отличие от сетевого. Учтите, что подключенный диск долго соображает при сохранении.
Данное решение задачи не отвечает нескольким условиям. В частности: 1) NetDrive - платная программа 2) Занимает системные ресурсы (одну из букв сетевых дисков) 3) Загрузка может происходить на несколько облачных дисвков в одной программе
В своем Сообщение № 28 я привел пример макроса, который подключает сетевой диск Yandex диска, а потом отключает, но данное решениеимеет один мнус -время коннекта к диску слишком большое. Поэтому я воспользовался решением представленным в сообщении Сообщение № 18.
В качетве параметров
LocalFilePath$ RemotePath$
проиведнноой в Сообщение № 18 процедуры UploadFile(LocalFilePath$, RemotePath$)
[vba]
Код
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
[/vba]
Я взял следующие параметры LocalFilePath$ = "c:\#work\777(minus).mp3" RemotePath$ = "777.mp3"
Запустил пример, для закачивания фала в облако, преварительно изменив процедуру upload, чтобы выснить ответ, который дает сервер. [vba]
Код
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 .StatusText End With End Sub
[/vba]
Debug.Print .StatusText - чтобы получить ответ сервера. Ответ сервера .StatusText = "Conflict"
То есть используя код, приведенный в Сообщении 18, я получил отклик сервера о неком конфликте файлов (или конфликте имен файло), и загрузка файла в облако не произошла. Я задал вопрос:
Я попробовал запустить представленный код, сервер ответил .StatusText = Conflict Вот процедура попытки загрузить в коренную папку [vba]
Код
Sub Пример() UploadFile "c:\#work\777(minus).mp3", "777.mp3"
End Sub
[/vba]
Далее я написал исходные условия загрузки файла
1. Файл на локальном диске существует 2. Вручную загружается 3. На облачном диске такого файла нет.
Чтобы исключть, как мне кажется, возможные ошибки и ненужные рассуждения на темы:
1. "А у вас файл присуствовует на локальном диске по заданному пути?" 2. "А вы свой файл вручную загружать на яндекс диск пробовали и успешно?" 3. "А у вас такой файл уже есть в корневом каталоге обласного диска?"
Еще раз задаю вопрос: что может значить значение ответа сервера Яндекс Диска:
.StatusText = "Conflict" и отрицательный результат работы процедуры по загрузке файла Upload из сообщения 18 (файл на облачный диск не закгружен).vcomp71
Если VBA написать русскими буквами, то получится МИФ.
Сообщение отредактировал vcomp71 - Понедельник, 22.10.2018, 19:08
А вы уверены, что в параметр RemotePath нужно сувать имя файла? изменение имени файла реализовано не было, RemotePath предназначен для указания пути к папке в ЯДиске
что может значить значение ответа сервера Яндекс Диска:
.StatusText = "Conflict"
Видимо, то, что нет там папки с именем 777.mp3
[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$, Optional RemotePath$ = "/", Optional RemoteFilename$ = "") Dim FileContents As Variant, FileName$ RemotePath = RemotePath & IIf(Right(RemotePath, 1) = "/", "", "/") RemoteFilename = IIf(Len(RemoteFilename), RemoteFilename, StrReverse(Split(StrReverse(LocalFilePath), "\")(0))) 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 & RemoteFilename), 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 .statustext 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]
А вы уверены, что в параметр RemotePath нужно сувать имя файла? изменение имени файла реализовано не было, RemotePath предназначен для указания пути к папке в ЯДиске
что может значить значение ответа сервера Яндекс Диска:
.StatusText = "Conflict"
Видимо, то, что нет там папки с именем 777.mp3
[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$, Optional RemotePath$ = "/", Optional RemoteFilename$ = "") Dim FileContents As Variant, FileName$ RemotePath = RemotePath & IIf(Right(RemotePath, 1) = "/", "", "/") RemoteFilename = IIf(Len(RemoteFilename), RemoteFilename, StrReverse(Split(StrReverse(LocalFilePath), "\")(0))) 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 & RemoteFilename), 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 .statustext 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?
здравствуйте, помогите решить такую задачу: есть несколько яндекс-дисков. нужно обратиться к каждому, определить суммарный размер (занято/свободно) и получить названия папок первого уровня.