Option Explicit

Dim strUplURL, strUplText, strUplStatus, strUplResponse

strUplURL = "http://vhost4353.cpsite.ru/upload.php"
strUplText = "TEST STRING" & vbCrLf & "Этот текст загружен c помощью скрипта http://pastebin.com/Z3Yyu7e4"
UploadText strUplURL, strUplText, strUplStatus, strUplResponse
MsgBox strUplStatus & vbCrLf & strUplResponse

Sub UploadText(strURL, strText, strStatus, strResponse)
	
	Dim strBoundary, bytPayLoad
	
	On Error Resume Next
	strBoundary = String(6, "-") & Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", "")
	With CreateObject("ADODB.Stream")
		.Mode = 3
		.Charset = "Windows-1251"
		.Open
		.Type = 2
		.WriteText "--" & strBoundary & vbCrLf
		.WriteText "Content-Disposition: form-data; name=""upload_file""; filename=""content.txt""" & vbCrLf
		.WriteText "Content-Type: octet/stream" & vbCrLf & vbCrLf
		.WriteText strText
		.WriteText vbCrLf & "--" & strBoundary & "--"
		.Position = 0
		.Type = 1
		bytPayLoad = .Read
	End With
	With CreateObject("MSXML2.ServerXMLHTTP") 
		.SetTimeouts 0, 60000, 300000, 300000
		.Open "POST", strURL, False 
		.SetRequestHeader "Content-type", "multipart/form-data; boundary=" & strBoundary
		.Send bytPayLoad
		If Err.Number <> 0 Then
			strStatus = Err.Description & " (" & Err.Number & ")"
		Else
			strStatus = .StatusText & " (" & .Status & ")"
		End If
		strResponse = .ResponseText
	End With
	
End Sub