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

Best Practices: Disaster Recovery Testing

Besides backup, any IT division should have a disaster recovery plan. You will find a few tips below relating to the development of such a plan and to what issues one should pay special attention in the course of backup planning.

Question has a verified solution.

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

This article outlines the process to identify and resolve account lockout in an Active Directory environment.
The Windows functions GetTickCount and timeGetTime retrieve the number of milliseconds since the system was started. However, the value is stored in a DWORD, which means that it wraps around to zero every 49.7 days. This article shows how to solve t…
This tutorial will walk an individual through the process of transferring the five major, necessary Active Directory Roles, commonly referred to as the FSMO roles to another domain controller. Log onto the new domain controller with a user account t…
The viewer will learn the basics of jQuery, including how to invoke it on a web page. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery.: (CODE)

740 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