mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Макрос отправки файла на файлообменник zalil.ru

Иногда требуется выложить некоторый файл в общий доступ, и поделиться ссылкой на него.

Для автоматизации этой задачи и предназначена функция UploadFile

Данная функция принимает в качестве параметра ссылку на файлообменник, и полный путь к загружаемому файлу.

Результатом работы функции является ссылка для скачивания загруженного файла.

(способ програмного формирования POST-запроса был выбран потому, что не удаётся средствами программы заполнить поле HTMLInputFileElement)

Function UploadFile(ByVal DestURL As String, ByVal FileName As String) As String
    ' функция принимает в качестве параметров:
    ' DestURL - ссылку на файлообменник
    ' FileName - полный путь к загружаемому файлу
    ' Возвращает ссылку на загруженный файл (например, httр://zalil.ru/upload/31336448 )

    Dim sFormData As String, d As String: On Error Resume Next
    'Boundary of fields.    Be sure this string is Not In the source file
    Const Boundary As String = "---------------------------UPLOADER-from-EducatedFool----ExcelVBA.ru"
    sFormData = GetFile(FileName)    'Get source file As a string.
    FormData = "--" + Boundary + vbCrLf    'Build source form with file contents
    FormData = FormData + "Content-Disposition: form-data; name=""" + "file" + """;"
    FormData = FormData + " filename=""" + Dir(FileName) + """" + vbCrLf
    FormData = FormData + "Content-Type: application/octet-stream" + vbCrLf + vbCrLf
    FormData = FormData + sFormData
    FormData = FormData + vbCrLf + "--" + Boundary + "--" + vbCrLf
 
    Dim WebBrowser: Set WebBrowser = CreateObject("InternetExplorer.Application")    '  WebBrowser.Visible = True
    'Send the form data To URL As POST request
    Dim bFormData() As Byte: ReDim bFormData(Len(FormData) - 1)
    bFormData = StrConv(FormData, vbFromUnicode)
 
    WebBrowser.Navigate DestURL, , , bFormData, "Content-Type: multipart/form-data; boundary=" + Boundary + vbCrLf
 
    Do While WebBrowser.Busy: DoEvents: Loop
    UploadFile = WebBrowser.LocationURL: If UploadFile = DestURL Then UploadFile = ""
    WebBrowser.Quit
End Function
 
Function GetFile(FileName As String) As String    'read binary file As a string value
    ' вспомогательная функция. Возвращает текстовую строку - файл FileName в юникоде
    Dim FileContents() As Byte, FileNumber As Integer
    ReDim FileContents(FileLen(FileName) - 1)
    FileNumber = FreeFile
    Open FileName For Binary As FileNumber
    Get FileNumber, , FileContents
    Close FileNumber
    GetFile = StrConv(FileContents, vbUnicode)
End Function

Пример использования функции UploadFile

:

Sub ПримерОтправкиФайлаНаФайлообменник()
    FileName$ = "C:\Documents and Settings\Admin\Рабочий стол\ArigatoRuler.exe"
    URL$ = "http://zalil.ru/upload/"
 
    If Dir(FileName$, vbNormal) = "" Then    ' проверяем наличие файла FileName$
        MsgBox "Файл: " & FileName$ & " не найден", vbCritical, "Отправка файла невозможна!"
        Exit Sub
    End If
 
    СсылкаНаЗагруженныйФайл = UploadFile(URL$, FileName$)    ' пытаемся отправить файл

    If Len(СсылкаНаЗагруженныйФайл) Then
        MsgBox "Ссылка для скачивания: " & СсылкаНаЗагруженныйФайл, vbInformation, _
               "Файл успешно загружен на файлообменник zalil.ru"
    Else
        MsgBox "Файл: " & FileName$, vbCritical, _
               "Не удалось отправить файл на файлообменник zalil.ru"
    End If
End Sub

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Здравствуйте, Алексей
Напишите мне на почту (или в скайп), — обсудим нюансы и стоимость работы, и, если договоримся, то через день-два макрос будет готов

Здравствуйте! Хочу сделать заказ.
Необходимо изменить данный макрос, чтобы он заливал изображения на http://uploads.ru/api?upload/
У самого не получилось, возвращается ответ в JSON. А надо чтоб ссылка на загруженный файл выводилась в MsgBox.
Сообщите пожалуйста о вашем решении на почту.

Что за запрос вы собрались отправлять?
Если требуется скопировать ("залить") файл на сервер в локальной сети, то достаточно одной строки кода:

filecopy "путь к локальному файлу", "путь к файлу на сервере"

команда WebBrowser.Navigate служит для отправки сформированного запроса на обменник.
А как отправить запрос на сервер в локальной сети? Ведь WebBrowser этом случае не нужен...
Спасибо.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _                          _   _         
/ | ___ _ _ __ _ | | | | __ _
| | / __| | | | | / _` | | |_| | / _` |
| | | (__ | |_| | | (_| | | _ | | (_| |
|_| \___| \__, | \__, | |_| |_| \__, |
|___/ |_| |___/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.