VBScript: OLEDB Persistence Provider Error.

Posted on 2008-10-16
Last Modified: 2013-11-29
I am not a vbscript developer, I have a bare understanding of the language and what it does from knowledge of other languages (php, sql, xhtml, javascript etc).  I have found a vbscript online that connects to active directory and pulls down information into an xml file and saves it as html.

I have implemented this script for 10 other servers and terminal servers that all work correctly.  However this is the first time doing it on a 64bit Windows Server 2003.  All others have been 32 bit.

The script is not exactly as it was how I found it, I have modified it and added to it to meet my needs including some code that I wrote of my own (From basic vbscript understanding)

I am getting these errors:

Microsoft OLEDB Persistence Provider: Requested conversion is not supported.


Script: scriptname
Line: 53
Char: 1
Error: Requested conversion is not supported.
Code: 80040E1D
Source: Microsoft OLEDB Persistence Provider

Line 53 is this line:
rsAD.Save xml, adPersistXML

I've attached the entire code.  The issue is not with the XML file - the HTML file saves correctly but all the active directory information that should be there, is not there.  

The script works fine on a 32bit server.  

I have tried executing the script with both \system32\cscript and \syswow64\cscript
Const adPersistXML = 1
Const ForWriting = 2
'on error resume next
Dim WshShell, WshNet, rsAD, Com, ConAD, f
'We need to get details from attributes that are only available from the LDAP provider
'We cannot assume that the AdsSecurity.DLL is available on the client to retrieve our DN
'What we do know, is who we are (samaccountname) and that must be unique within a domain
Set WshNet = WScript.CreateObject("WScript.Network")
sUsername = WshNet.UserName
'Wscript.Network knows the Netbios Domain, but we might not know our DNS domainname
sPrefix = "LDAP://"
Set cont = GetObject(sPrefix & "rootdse")
sDN = cont.get("defaultnamingcontext")
'Alright - we are now prep'd to do a little search to get our adspath...
'We will open an ADO connection to AD
Set conAD = CreateObject( "ADODB.Connection" )
Set com = CreateObject( "ADODB.Command" )
'set the provider
conAD.Provider = "ADSDSOObject"
' Open a connection object
conAD.Open "Active Directory Provider"
Set Com.ActiveConnection = conADa
'what do we want to find - well our details...
sFilter = "(samaccountname=" & sUsername & ")"
'what do we need to know?
sAttributes = "givenname,sn,telephoneNumber,mail,streetAddress,l,st,postalCode,co,mobile,company,facsimileTelephoneNumber,title,department,wWWHomePage,ipphone,postOfficeBox"
'build the command string
Com.CommandText = "<" & sPrefix & sDN & ">;" & sFilter & ";" & sAttributes
' Set some preferences for search
Com.Properties( "Page Size" ) = 512
Com.Properties( "TimeOut" ) = 30 ' seconds
'Execute the query to get our objects from Active Directory.
Set rsAD = CreateObject("ADODB.Recordset")
Set rsAD = Com.Execute
If (Err.Number <> 0) Then
    WScript.Echo Err.Number, "on Execute"
End If
'WScript.Echo "LDAP user objects:" & rsAD.RecordCount
Set xml = CreateObject("Microsoft.XMLDOM")
rsAD.Save xml, adPersistXML
XML.async = False
Set xsl = CreateObject("Microsoft.XMLDOM")
XSL.async = False
'Load the XSL file. We keep it in the same path as the script, but it could be stored anyway. e.g. Webserver
XSL.load "\\king2003\netlogon\DeploySignatures\signature.xml"
XSL.preserveWhiteSpace = True
'Lets Save the signature file to disk to the profile - we are aiming for the Outlook signature path
Set WshShell = CreateObject("Wscript.Shell")
sUserProfile = WshShell.ExpandEnvironmentStrings("%appdata%")
sSignaturePath= sUserProfile & "\Microsoft\Signatures\"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(sUserProfile & "\Microsoft") = False Then
      Set f = fso.CreateFolder(sUserProfile & "\Microsoft")
End If
If fso.FolderExists(sUserProfile & "\Microsoft\Signatures") = False Then
      Set f = fso.CreateFolder(sUserProfile & "\Microsoft\Signatures")
End If
sOutputfile = sSignaturePath & sUsername & ".htm"
Set FSO = CreateObject("Scripting.Filesystemobject")
Set f = fso.OpenTextFile(sOutputFile,ForWriting,True)
f.Write xml.transformNode(xsl)
'Make it the default signature, if no signature is set.
'Is not dependant on any specific Office Version
'Outlook needs to be CLOSED - so ensure this script is run before outlook is loaded.
Call SetDefaultSignature(sUsername, "")
	Dim objFSO
	Dim strNWStatLoc
	Dim strLocStatLoc
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	strNWStatLoc = "\\king2003\netlogon\DeploySignatures\logo.gif"
	strLocStatLoc = sUserProfile & "\Microsoft\Signatures\"
	objFSO.CopyFile strNWStatLoc, strLocStatLoc, True
	Set objFSO = Nothing
Sub SetDefaultSignature(strSigName, strProfile)
    Const HKEY_CURRENT_USER = &H80000001
    strComputer = "."
        Set objreg = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
        strKeyPath = "Software\Microsoft\Windows NT\" & "CurrentVersion\Windows " & "Messaging Subsystem\Profiles\"
        ' get default profile name if none specified
        If strProfile = "" Then
            objreg.GetStringValue HKEY_CURRENT_USER, _
              strKeyPath, "DefaultProfile", strProfile
        End If
        ' build array from signature name
        myArray = StringToByteArray(strSigName, True)
        strKeyPath = strKeyPath & strProfile & "\9375CFF0413111d3B88A00104B2A6676"
        objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrProfileKeys
        For Each subkey In arrProfileKeys
            strsubkeypath = strKeyPath & "\" & subkey
            'On Error Resume Next
            objreg.SetBinaryValue HKEY_CURRENT_USER, strsubkeypath, "New Signature", myArray
            objreg.SetBinaryValue HKEY_CURRENT_USER, strsubkeypath, "Reply-Forward Signature", myArray
End Sub
Public Function StringToByteArray(Data, NeedNullTerminator)
    Dim strAll
    strAll = StringToHex4(Data)
    If NeedNullTerminator Then
        strAll = strAll & "0000"
    End If
    intLen = Len(strAll) \ 2
    ReDim arr(intLen - 1)
    For i = 1 To Len(strAll) \ 2
        arr(i - 1) = CByte _
                   ("&H" & Mid(strAll, (2 * i) - 1, 2))
    StringToByteArray = arr
End Function
Public Function StringToHex4(Data)
    ' Input: normal text
    ' Output: four-character string for each character,
    '         e.g. "3204" for lower-case Russian B,
    '        "6500" for ASCII e
    ' Output: correct characters
    ' needs to reverse order of bytes from 0432
    Dim strAll
    For i = 1 To Len(Data)
        ' get the four-character hex for each character
        strChar = Mid(Data, i, 1)
        strTemp = Right("00" & Hex(AscW(strChar)), 4)
        strAll = strAll & Right(strTemp, 2) & Left(strTemp, 2)
    StringToHex4 = strAll
End Function

Open in new window

Question by:TawneyFollett
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions

Accepted Solution

TawneyFollett earned 0 total points
ID: 22818642
I Found the solution to my problem, it was that I added postOfficeBox to the attribute list and it doesn't seem to like it (This is odd though as I've added ipphone and l without any issues)

Featured Post

WordPress Tutorial 1: Installation & Setup

WordPress is a very popular option for running your web site and can be used to get your content online quickly for the world to see. This guide will walk you through installing the WordPress server software and the initial setup process.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article helps those who get the 0xc004d307 error when trying to rearm (reset the license) Office 2013 in a Virtual Desktop Infrastructure (VDI) and/or those trying to prep the master image for Microsoft Key Management (KMS) activation. (i.e.- C…
Originally, this post was published on Monitis Blog, you can check it here . In business circles, we sometimes hear that today is the “age of the customer.” And so it is. Thanks to the enormous advances over the past few years in consumer techno…
This is used to tweak the memory usage for your computer, it is used for servers more so than workstations but just be careful editing registry settings as it may cause irreversible results. I hold no responsibility for anything you do to the regist…
Are you ready to implement Active Directory best practices without reading 300+ pages? You're in luck. In this webinar hosted by Skyport Systems, you gain insight into Microsoft's latest comprehensive guide, with tips on the best and easiest way…
Suggested Courses

617 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question