Monday, September 29, 2008

How to fetch records from database and write a text file using vbscript

'How to fetch records from database and write a text file using vbscript.
'If you want to get records from database and write to a text file please use the 'following code
'VBSCRIPT CODE TO WRITE A TEXT FILE,Windows Scipt file to backup database. vbs file
Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Configure this script then run from CMD using cscript
'
' Use the constants below to configure the script
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Database server name
Const server = ""

' Use trusted (windows authenitcation) or standard (SQL Server authentication)

Const trusted = FALSE

' Database user name - not needed for trusted connection

Const userId = ""

' Database password - not needed for trusted connection

Const password = ""

' Database

Const dataBase = ""

Const useUnicode = TRUE
' Set the name of the created file
Const fileName = "records.txt"

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DO NOT EDIT BELOW THIS LINE UNLESS YOU WANT TO ENCHANCE/CHANGE
' THE FUNCTIONALLITY OF THE SCRIPT
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Variables used in the script
Dim db,i,connectString,fields,rs

' Userful ADODB constants
Const adOpenStatic = 3
Const adLockReadOnly = 1
Const adCmdText = 1
Const adUseClient = 3
Const adLockBatchOptimistic = 4


If trusted Then
connectString="Provider=SQLNCLI;Server=" & server & ";Database=" & dataBase & ";Trusted_Connection=yes;"
Else
connectString="Provider=SQLNCLI;Server=" & server & ";Database=" & dataBase & ";Uid=" & userId & ";Pwd=" & password & ";"
End If

Set db = CreateObject("ADODB.Connection")
db.Open connectString
db.Execute "USE " + dataBase

DumpDBDataToFile db,fileName,dataBase,useUnicode
WScript.Echo "All done"
WScript.Quit



Public Sub DumpDBDataToFile(ado, fileName, dataBase,useUnicode)
Dim trc
trc=0
Dim fs
' Open the output file and select the chosen format
Set fs = CreateObject("Scripting.FileSystemObject")
Dim ts
If useUnicode Then
Set ts = fs.OpenTextFile(fileName, 2, True,-1)
Else
Set ts = fs.OpenTextFile(fileName, 2, True)
End If

Dim t,tt
Dim rec
Dim c
Dim trigs


ado.Execute "BEGIN TRANSACTION"
'write sql quey\ry here
Set rec = GetDisconRS(ado,"SELECT * from tablename" )
Dim sql
Dim sql1
Dim first
first = True
If Not rec.EOF Then
rec.MoveFirst
While Not rec.EOF
Dim i
If first Then

sql1 = sql1
first = False

End If
sql = sql1
Dim vt
Dim f,col

For i = 0 To rec.fields.count - 1
f = rec.fields(i).value
col = rec.fields(i).name


''''''''''''''check for padding'''''''''''''
if col="ColumnNAme" then
' MsgBox(f)
f=Rpad(f," ",3)
' MsgBox(Rpad("1"," ",3))
end if




'''''end padding''''''''''


vt = varType(f)
If vt = 1 Then
f = "Null"
ElseIf vt = 2 Or vt = 3 Or vt = 4 Or vt = 5 Or vt = 6 Or vt = 14 Then
f = DBEscapeNumber(CStr(f))
ElseIf vt = 11 Then
If vt Then
f = "1"
Else
f = "0"
End If
ElseIf vt = 8 Then
f = DBEscapeString(CStr(f))
ElseIf vt = 7 Then
f = DBEscapeDate(CStr(f))
ElseIf vt = 17 Then
f = "0x" + Right( "0" & Hex(f),2)
ElseIf vt = 8209 Then
f = "0x" + BinToHex(f)
Else
WScript.Echo "Could not reformat", "Table=" & t & " Col=" & rec.fields(i).name & " vt=" & vt
WScript.Quit
End If
If i > 0 Then sql = sql + ","
sql = sql + f
Next
sql = sql
ts.WriteLine sql

trc=trc+1


rec.MoveNext
Wend

End If
rec.Close




ts.Close
End Sub

'''function for padding
Function Rpad (MyValue, MyPadChar, MyPaddedLength)
'MsgBox(string(MyPaddedLength - Len(MyValue), MyPadChar))
Rpad = MyValue & string(MyPaddedLength - Len(MyValue), MyPadChar)
End Function


Function GetDisconRS(ado,sql)
Dim recset
Set recset = CreateObject("ADODB.Recordset")
recset.CursorLocation = adUseClient
recset.CursorType = adOpenStatic
recset.LockType = adLockBatchOptimistic

recset.Open sql, ado, , , adCmdText
Set recset.ActiveConnection = Nothing
Set GetDisconRS = recset
End Function


Function DateLong(myDate)
Dim months
months=Split("january,february,march,april,may,june,july,august,september,october,november,december",",")
DateLong= _
DatePart("D",mydate) & " " & _
months( DatePart("M",myDate)-1) & " " & _
DatePart("YYYY",mydate)
End Function

''
Function DBEscapeDate(myDate)

DBEscapeDate=DBEscapeString(DateLong(myDate))
End Function

Function DBEscapeString(myString)
DBEscapeString="'" & Replace(myString,"'","''") & "'"
End Function

Function DBEscapeNumber(myNumber)
If NOT IsNumeric(myNumber) Then myNumber=0
myNumber=myNumber*1.0
DBEscapeNumber=Replace(myNumber & "","'","''")
End Function



Function BinToHex(data)
Dim ret
Dim l
Dim i
Dim lb
Dim h
Dim d
Dim o
lb = LBound(data) - 1
l = UBound(data) - LBound(data) + 1
ret = String(l * 2, "0")
Redim o(l-1)

For i = 1 To l
d = 255 and ascb(midb(data,i,1))
If d > 15 Then
o(i-1) = Hex(d)
Else
o(i-1) = "0" + Hex(d)
End If
Next
BinToHex = Join(o,"")
End Function

'Please rate this if you like it

1 comment:

L. Venkata Subramaniam said...

wow you have code level stuff on your blog....I am sure this must be very useful for practitioners? Is this for your future reference also?