Showing posts with label Database Backup Vbscript. Show all posts
Showing posts with label Database Backup Vbscript. Show all posts

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