MassMailer/tools/probe-mdb-providers.vbs

' Run with 32-bit and 64-bit cscript.exe to verify actual .mdb capability.
' Creates and removes a small temporary .mdb; it never touches campaign data.
Option Explicit

Dim fso, hostPath, providers, provider
Set fso = CreateObject("Scripting.FileSystemObject")
hostPath = WScript.FullName
providers = Array("Microsoft.Jet.OLEDB.4.0", "Microsoft.ACE.OLEDB.12.0", "Microsoft.ACE.OLEDB.16.0")

WScript.Echo "Script host: " & hostPath
For Each provider In providers
    ProbeProvider CStr(provider)
Next

Sub ProbeProvider(providerName)
    Dim testPath, catalog, connection, recordset, errorText, okay
    testPath = fso.BuildPath(fso.GetSpecialFolder(2), _
        "MassMailer_" & fso.GetBaseName(fso.GetTempName()) & ".mdb")
    okay = False
    errorText = ""

    On Error Resume Next
    Set catalog = CreateObject("ADOX.Catalog")
    If Err.Number <> 0 Then
        errorText = Err.Description
        Err.Clear
    Else
        catalog.Create "Provider=" & providerName & ";Data Source=" & testPath & _
            ";Jet OLEDB:Engine Type=5;"
        If Err.Number <> 0 Then
            errorText = Err.Description
            Err.Clear
        Else
            Set catalog = Nothing
            Set connection = CreateObject("ADODB.Connection")
            connection.Open "Provider=" & providerName & ";Data Source=" & testPath & ";"
            If Err.Number <> 0 Then
                errorText = Err.Description
                Err.Clear
            Else
                connection.Execute "CREATE TABLE Probe (Id INTEGER)"
                connection.Execute "INSERT INTO Probe (Id) VALUES (1)"
                Set recordset = connection.Execute("SELECT Id FROM Probe")
                If Err.Number <> 0 Then
                    errorText = Err.Description
                    Err.Clear
                ElseIf recordset.EOF Then
                    errorText = "Readback returned no rows"
                ElseIf CLng(recordset.Fields("Id").Value) <> 1 Then
                    errorText = "Readback returned wrong value"
                Else
                    okay = True
                End If
            End If
        End If
    End If

    If Not recordset Is Nothing Then recordset.Close
    If Not connection Is Nothing Then connection.Close
    Set recordset = Nothing
    Set connection = Nothing
    Set catalog = Nothing
    If fso.FileExists(testPath) Then fso.DeleteFile testPath, True
    On Error GoTo 0

    If okay Then
        WScript.Echo providerName & ": OK (create/write/read .mdb)"
    Else
        WScript.Echo providerName & ": UNAVAILABLE (" & errorText & ")"
    End If
End Sub