Howto: WebDAV PUT using VBScript

' This example shows how to do a PUT of a message to a folder. What is being written with a PUT would
' be the MIME of a message and such MIME can also contain the MIME of the message.  PUT works against
' messaging items directly such as mail messages. It cannot be used to add an attachment without
' recreating the entire message. PUT is a desctructive write against the URL specified.

' You can use Outlook Express to create a mime message. To use this sample, create a mime message
' and save it as c:\MyTestEmail.eml, the run the code.

' NOTE: You need to have a header of "Translate" set to "f" in order to read mime of an item with a PUT.
' NOTE: A PUT should only be used for writting message. It's often used for creating messages for sending.

' Do the TODO Sections
' ReadFileText - Used to PUT (write) an item to a file in a folder.
' Parameters:
'   sFile - The file to read
' Returns:
'   A string containing the content of the file.
Function ReadFileText (sFile)
    Dim objFSO 'As FileSystemObject
    dim oTS
    dim sText
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set oTS = objFSO.OpenTextFile(sFile)
    sText = oTS.ReadAll

    set oTS = nothing
    Set objFSO = nothing
    ReadFileText = sText
end Function

' DoWebdavPut- Used to PUT (write) an item to a file in a folder.' Parameters:
'  sFolder          - The complete URI to PUT the item (includes item name).
'  sText            - The contents to write in the file.
'  sUser            - User ID for logging in.  Set to "" if using windows authentication
'  sPassword        - Password for logging in.  Set to "" if using windows authentication
' Returns:
'   Status response text
Private Function DoWebdavPut(sFolder, sText, sUser, sPassword) 
    Dim oXMLHttp 'As New MSXML2.XMLHTTP30
    Dim bSucess 'As Boolean
    Dim iStatus 'As Integer
    Dim sStatus 'As String
    Dim sResponse 'As String

    set oXMLHttp = CreateObject("microsoft.xmlhttp")
    If sUser <> "" Then
        oXMLHttp.Open "PUT", sFolder, False, sUser, sPassword   
         oXMLHttp.Open "PUT", sFolder, False ', sUser, sPassword   
    End If
    oXMLHttp.setRequestHeader "translate", "f" ' Set this to prevent stream problems
    oXMLHttp.Send sText ' Send the stream across
    bSucess = False
    iStatus = oXMLHttp.Status
    sStatus = oXMLHttp.statusText
    If (iStatus >= 200 And iStatus < 300) Then
        wscript.echo  "PUT: Success!   " & "Results = " & iStatus & ": " & sStatus
        bSucess = True
    ElseIf iStatus = 401 Then
        wscript.echo  "PUT: You don't have permission to do the job! Please check your permissions on this item."
        wscript.echo  "PUT: Request Failed.  Results = " & iStatus & ": " & sStatus
    End If
    Set oXMLHttp = Nothing
    DoWebdavPut = sStatus
End Function

Dim sHREF   'As String
Dim sUserName   'As String
Dim sPassword   'As String
Dim sFile  'As String
Dim sRet  'As String

sHREF = "http://myexserver/exchange/Administrator/Inbox/testabcdxx.EML"  ' TODO: change
sUserName = "Administrator"    ' TODO: change
sPassword = "test"    ' TODO: change
sFile = "c:\MyTestEmail.eml"  ' TODO: change
sRet = ""

sString = ReadFileText(sFile)

sRet = DoWebdavPut(sHREF, sString, sUserName, sPassword)

wscript.echo sRet

Skip to main content