VBScript/SQL Formatting Issue - vbscript

Okay so the script that I have written is almost fully functional but I would like to add two things to it. What it currently does is you type in a CallID number that is associated with other data on a database in SQL Server. When you type in the number into the msgbox it retrieves all the other columns that are associated with that particular number and outputs it to the command prompt and also outputs it to a text file on the hard drive. This is good, but the formatting is horrible. How would I go about improving the formatting of the file so it is more reading. Currently it is just a line with space seperating each piece of data. Also what I would like to be able to do is also have the name of each Column under each piece of data that is associated with that column. Any help would be appreciated. Here is my code with sensitive information omitted:
Dim strQuery
strQuery = InputBox("Enter CallID Please:")
Dim sServer
Dim sLogin
Dim sPwd
Dim sDb
Dim oCn
Dim oRs
Dim strFullQuery
Dim strfield
Const ForReading = 1
sServer = ""
sLogin = ""
sPwd = ""
sDb = ""
Set oCn = CreateObject( "ADODB.Connection" ) ' set oCn to create an object called ADODB.Connection
Set oRs = CreateObject( "ADODB.Recordset" ) ' set oRs to create an object called ADODB.Recordset
oCn.ConnectionString = "PROVIDER=SQLOLEDB" & _
";SERVER=" & sServer & _
";UID=" & sLogin & _
";PWD=" & sPwd & _
";DATABASE=" & sDb & " "
oCn.ConnectionTimeout=600
oCn.open 'Open the connection to the server
strFullQuery = "select * from dbo.CallLog where CallID=" + strQuery 'this is the SQL statement that runs a query on the DB
oRs.Open strFullQuery,oCn 'This opens the record set and has two parameters, strFullQuery and oCn
If oRs.EOF Then 'If open record set is at the end of file then...
wscript.echo "There are no records to retrieve; Check that you have the correct record number." 'echo that there is no records to retrieve.
End if
'if there are records then loop through the fields
oRs.MoveFirst 'move to the first object in the record set and set it as the current record
Do Until oRs.EOF ' Do while not open record set is not end of file
Set objFileSystem = WScript.CreateObject("Scripting.FileSystemObject") 'Set objFileSystem to create object Scripting.FileSystemObject
Set objOutPutFile = objFileSystem.CreateTextFile("c:\test.txt", True) 'Set objOutPutFile to create object objFileSystem.CreateTextFile
objOutPutFile.WriteLine strColumnNames
strfield = oRs.GetString
if strfield <> "" then 'If strfield doesn't equal "" then
WScript.echo strfield
objOutPutFile.WriteLine strfield &"|"
'objFileSystem.close
objOutPutFile.close
end If
'oRs.MoveNext 'Move to the next object in the record set
Loop
oCn.Close

You can add space to make fixed-widths. Let's say you know that every field will be 20 characters or less:
objOutPutFile.WriteLine strfield & String(20-Len(strfield)," ") & "|"

Related

Text files handles differently

I am trying to read from a csv.txt file using Ado Recordset
I get no results back when trying..
When I copy the contents of the original file into a new text file, and read from that file, it works just fine.
Any ideas what the reason for this might be?
The second file is smaller in size, about 1/2. That's the only difference I can see. This is driving me mad :-)
'Edit
Update with code & schema.ini
Code:
Sub ImportTextFiles()
Dim objAdoDbConnection As ADODB.Connection
Dim objAdoDbRecordset As ADODB.Recordset
Dim strAdodbConnection As String
Dim pathSource As String
Dim filename As String
pathSource = "C:\Users\me\Desktop\Reports\"
filename = "test1.txt"
'filename = "test2.txt"
strAdodbConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & pathSource _
& ";Extended Properties=""text;HDR=yes;FMT=Delimited"";"
Set objAdoDbConnection = CreateObject("Adodb.Connection")
Set objAdoDbRecordset = CreateObject("ADODB.Recordset")
With objAdoDbConnection
.Open (strAdodbConnection)
With objAdoDbRecordset
.Open "Select top 10 * FROM " & filename & " WHERE [Date] > #01/01/2000# ", objAdoDbConnection, adOpenStatic, adLockOptimistic, adCmdText
If Not objAdoDbRecordset.EOF Then objAdoDbRecordset.MoveFirst
Do While Not objAdoDbRecordset.EOF
Debug.Print "Field(0): " & objAdoDbRecordset(0).Value
objAdoDbRecordset.MoveNext
Loop
.Close
End With
.Close
End With
Set objAdoDbRecordset = Nothing
Set objAdoDbConnection = Nothing
End Sub
Schema.ini:
[Test1.txt]
col1=date text
col2=interval integer
col3=application text
[Test2.txt]
col1=date text
col2=interval integer
col3=application text
notepadd++ gave me the answer, file1 is ucs-2 encoded, the newly created utf-8

VBScript: I want to take the contents of a file and run an UPDATE statement using the contents of each line

I have made a connection to a database. I want to take the contents of a file and run an UPDATE statement using the contents of each line.
Database Connection
Option Explicit
Dim sDir : sDir = "\\Server1\Data"
Dim sCS : sCS = Join(Array( _
"Provider=vfpoledb" _
, "Data Source=" & sDir _
, "Collating Sequence=general" _
), ";")
Dim oCN : Set oCN = CreateObject("ADODB.CONNECTION")
oCN.Open sCS
oCN.Close
File
STAD 1
SECA 2
..
UPDATE Statement
For this line:
STAD 1
It would run:
UPDATE B_SNAME.DBF SET SN_ANALSYS = 1 WHERE SN_ACCOUNT = STAD
I am extremely new to VBScript and DBF. I would have no problem writing a little Bash script to do this on our Linux side but here I am lost.
Please can someone provide some information on how I could do it, or even an example (that would be awesome)? :-)
If you separate the fields with one space or any single character (called a delimiter) you can use the split function to separate the fields. You will end up with something like this (I have not tested this)
Dim strSQL
Dim strFilename
Dim sConnString
Dim scs
Dim oCN
Dim oCmd
Dim fso
Dim f
strFilename = "C:\Temp\MyFile.txt"
sConnString = "Provider=vfpoledb;Data Source=\\Server1\Data;Collating Sequence=general;"
strSQL = "UPDATE B_SNAME.DBF SET SN_ANALSYS = p1 WHERE SN_ACCOUNT = p2"
Set oCN = CreateObject("ADODB.CONNECTION")
oCN.Open sConnString
Dim oCmd
Set oCmd = CreateObject("ADODB.Command")
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(strFilename)
Do Until f.AtEndOfStream
sArray = Split(f.ReadLine, " ")
oCmd.Parameters.Append oCmd.CreateParameter("p1", adChar, adParamInput, 4, sArray(1))
oCmd.Parameters.Append oCmd.CreateParameter("p2", adChar, adParamInput, 8, sArray(0))
oCmd.CommandText = strSQL
oCmd.Execute
Loop
f.Close
If oCN.State = 1 Then oCN.Close
Set oCmd = Nothing
Set oCN = Nothing
Most lines are delimited with either tabs or commas but there is no reason why you cannot use a space as long as it does not appear in your data.
Here is a simple example to read the data file and get each field into a variable. This assumes your data file contains a four character account name followed by five spaces and then a number.
Option Explicit
Const ForReading = 1
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim line
Dim sn_analsys
Dim sn_account
Dim dataFile
Set dataFile = fso.OpenTextFile("C:\SomeFolder\data.txt")
Do Until dataFile.AtEndOfStream
line = dataFile.ReadLine
sn_account = Left(line, 4)
sn_analsys = Mid(line, 10)
WScript.Echo "sn_account = " & sn_account
WScript.Echo "sn_analsys = " & sn_analsys
'
' Do whatever processing you need to do...
'
Loop
dataFile.Close
If you change the data file to separate the fields by one space, you can use Split to get each field.
Dim line
Dim fields
Dim dataFile
Set dataFile = fso.OpenTextFile("C:\SomeFolder\data.txt")
Do Until dataFile.AtEndOfStream
line = dataFile.ReadLine
fields = Split(line)
WScript.Echo "sn_account = " & fields(0)
WScript.Echo "sn_analsys = " & fields(1)
WScript.Echo
'
' Do whatever processing you need to do...
'
Loop

VBScript code error when using ActiveX to get data from the database

Here is my code, I am trying to open a connection to our database and then using ActiveX to return all the data from column in a table and then outputting it to a text document. I'm getting this error.
PullData.vbs(41, 1) ADODB.Recordset: Item cannot be found in the
collection corresponding to the requested name or ordinal.
Here is my code, omitting sensitive information:
Const ForReading = 1
Dim sServer
Dim sLogin
Dim sPwd
Dim sDb
Dim oCn
Dim oRs
sServer = ""
sLogin = ""
sPwd = ""
sDb = ""
Set oCn = CreateObject( "ADODB.Connection" ) ' set oCn to create an object called ADODB.Connection
Set oRs = CreateObject( "ADODB.Recordset" ) ' set oRs to create an object called ADODB.Recordset
oCn.ConnectionString = "PROVIDER=SQLOLEDB" & _
";SERVER=" & sServer & _
";UID=" & sLogin & _
";PWD=" & sPwd & _
";DATABASE=" & sDb & " "
oCn.ConnectionTimeout=600
oCn.open 'Open the connection to the server
strSelString = "select CallID from dbo.CallLog" 'this is the SQL statement that runs a query on the DB
oRs.Open strSelString,oCn 'This opens the record set and has two parameters, strSelString and oCn
If oRs.EOF Then 'If open record set is at the end of file then...
wscript.echo "There are no records to retrieve; Check that you have the correct record number." 'echo that there is no records to retrieve.
End if
'if there are records then loop through the fields
Do While Not oRs.EOF ' Do while not open record set is not end of file
strfield = ors("Tracker")
if strfield <> "" then 'If strfield doesn't equal "" then
Set objFileSystem = WScript.CreateObject("Scripting.FileSystemObject") 'Set objFileSystem to create object Scripting.FileSystemObject
Set objOutPutFile = objFileSystem.CreateTextFile("c:\test.txt", True) 'Set objOutPutFile to create object objFileSystem.CreateTextFile
strcomputer = oRs 'strcomputer is set to read the line
wscript.echo strfield
objOutPutFile.WriteLine strfield &"|"
objFileSystem.close
objOutPutFile.close
end if
oRs.MoveNext
oCn.Close
Loop
You ask for the CallID column;
"select CallID from dbo.CallLog"
but then try to read something else:
strfield = ors("Tracker")
so either select Tracker or read CallID.
You could also probably create/open the file outside of the loop.

How to update a recordset

here is my code
Dim Cn1 As ADODB.Connection
Dim iSQLStr As String
Dim field_num As Integer
Set Cn1 = New ADODB.Connection
Cn1.ConnectionString = _
"Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"DefaultDir=" & "C:\path\"
Cn1.Open
iSQLStr = "Select * FROM " & "file.txt" ' & " ORDER BY " & txtField.Text
field_num = CInt(1) - 1
Set Rs1 = Cn1.Execute(iSQLStr)
lstResults.Clear
While Not Rs1.EOF
DoEvents
Rs1.Fields(field_num).Value = "qaz"
If IsNull(Rs1.Fields(field_num).Value) Then
lstResults.AddItem "<null>"
Else
lstResults.AddItem Rs1.Fields(field_num).Value
End If
Rs1.MoveNext
Wend
The error i get is in this line
Rs1.Fields(field_num).Value = "qaz"
it says "The current recordset does not support updating", what is wrong in the code?
I'm not sure if this is valid for text files but with SQL Server you need to change the LockTypeEnum Value setting to allow editing see this link, the default is adLockReadOnly
Edit
According to this link it is not possible to edit a text file via ADO.

Active Directory PSO fine grained passwords msDS-MaximumPasswordAge

Looking how to create a vbscript to pull the maximum number of days a PSO policy has set. It comes back as a value of ... and I do not know how to get the real value that was set.
This is what I have so far:
Option Explicit
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Dim strFilePath, objFSO, objFile, adoConnection, adoCommand, objCDOConf
Dim objRootDSE, strDNSDomain, strFilter, strQuery, adoRecordset, objMaxPwdAge
Dim strDN, objShell, lngBiasKey, lngBias, blnPwdExpire, strDept, strAdd
Dim objDate, dtmPwdLastSet, lngFlag, k, address, objAdd, objMessage
' Check for required arguments.
If (Wscript.Arguments.Count < 1) Then
Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
& "cscript PwdLastChanged.vbs c:\MyFolder\UserList.txt"
Wscript.Quit(0)
End If
strFilePath = Wscript.Arguments(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Open the file for write access.
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "File " & strFilePath & " cannot be opened"
Wscript.Quit(1)
End If
On Error GoTo 0
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
' Use ADO to search the domain for all users.
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOOBject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
' Filter to retrieve all user objects.
strFilter = "(&(objectClass=msDS-PasswordSettings))"
' Filter to retrieve all computer objects.
strQuery = "<LDAP://CN=PSO-Information Systems,CN=Password Settings Container,CN=System,DC=yrmc,DC=org>;" _
& ";cn,msDS-LockoutDuration,msDS-MaximumPasswordAge,msDS-
PasswordSettingsPrecedence;subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
objFile.WriteLine adoRecordset.Fields("cn").Value
adoRecordset.MoveNext
Loop
adoRecordset.Close
I can get a value for cn and even msDS-PasswordSettingsPrecedence but not for msDS-MaximumPasswordAge. Any help would be appreciated.
This is at best a partial answer but I did some searching and I believe you will need one or more of the following:
DSGet/DSQuery
LDIFDE to manage PSO's.
Quest's "Free PowerShell Commands for Active Directory"
Using Quest's free tools, you might find this link handy
Put square brackets around our Active Directory attribute name:
See the blog post "How can I retrieve the value of an active directory attribute that has a hyphen in its name" for more.
you have to find UsersPSO location in your AD like that
domainLookupString = ""CN=UsersPSO,CN=Password Settings Container,CN=System,DC=COMPAY,DC=ORG";
then run the ldap query
ldapFilterString = "(&(objectClass=msDS-PasswordSettings))";
at the end, get the ldap attribute with the Maximum Password Age of the current PSO policy
"msDS-MaximumPasswordAge"

Resources