'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 
Monday, September 29, 2008
Subscribe to:
Post Comments (Atom)

1 comment:
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?
Post a Comment