'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
Showing posts with label Database Backup Vbscript. Show all posts
Showing posts with label Database Backup Vbscript. Show all posts
Monday, September 29, 2008
Subscribe to:
Posts (Atom)