Menggunakan XMLHTTP dan MSXML

Private Sub Command1_Click()
    Dim soapReq As String
    Dim objSOAPXMLDoc As New MSXML2.DOMDocument30
    Dim objXMLHTTP As New MSXML2.XMLHTTP30

    Dim btArr() As Byte

    Dim backSlashPos As Integer
    Dim fileNameNoPath As String

    soapReq = " " & _
    " " & _
    "   " & _
    "  " & _
    "    " & _
    "    " & _
    "  " & _
    "   " & _
    " "

    backSlashPos = InStrRev(txtFileName.Text, "\")
    If backSlashPos > 0 Then
        fileNameNoPath = Mid(txtFileName.Text, backSlashPos + 1)
    Else
        fileNameNoPath = txtFileName.Text
    End If

    objSOAPXMLDoc.loadXML soapReq

    objSOAPXMLDoc.setProperty "SelectionNamespaces", _
    "xmlns:pxml='http://samples.perfectxml.com/BinaryData'"

    objSOAPXMLDoc.selectSingleNode("//pxml:fileName").nodeTypedValue = _
    fileNameNoPath

    objSOAPXMLDoc.selectSingleNode("//pxml:imageData").dataType = _
    "bin.base64"

    Open txtFileName.Text For Binary Access Read As #1
    ReDim btArr(LOF(1))
    Get #1, , btArr()
    Close #1

    objSOAPXMLDoc.selectSingleNode("//pxml:imageData").nodeTypedValue = btArr
    MsgBox objSOAPXMLDoc.xml

    objXMLHTTP.open "POST", "http://localhost/EmpImages/EmpImages.asmx", False

    objXMLHTTP.setRequestHeader "Content-Type", "text/xml; charset=utf-8"

    objXMLHTTP.setRequestHeader "SOAPAction", _
    "http://samples.perfectxml.com/BinaryData/SaveImage"

    objXMLHTTP.setRequestHeader "Content-Length", Len(objSOAPXMLDoc.xml)

    objXMLHTTP.send objSOAPXMLDoc.xml

    MsgBox objXMLHTTP.Status & ": " & objXMLHTTP.statusText
    MsgBox objXMLHTTP.responseText

    Set objXMLHTTP = Nothing
    Set objSOAPXMLDoc = Nothing

End Sub