Megjegyzés:
' Ez egy megjegyzés
MINTA:
' --------------- SQL ripport ---------------
'********************************************************************
'*
'* Copyright Kecskeméti Lajos
'*
'* Module Name: sql_xls.vbs
'*
'* SQL eredmény XLS-be töltése
'*
'*
'********************************************************************
' alap beállítások
Option Explicit
ON ERROR RESUME NEXT
Err.Clear
' valtozók
Dim objRootDSE, strDNSDomain, adoConnection
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
Dim strName, strDN, objManagerList, strManagerDN
Dim objExcel, objWorkbook, objWorkSheet, x, y, celx,cely, eField, objRange, objRange2
Dim strExcelPath
Dim strCon
Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1
wscript.echo date
wscript.echo now
'--------- Oracle konnekció
strCon = "Driver={Microsoft ODBC for Oracle}; " & _
"CONNECTSTRING=(DESCRIPTION=" & _
"(ADDRESS=(PROTOCOL=TCP)" & _
"(HOST=szerver)(PORT=1521))" & _
"(CONNECT_DATA=(SID = DB))); uid=nev;pwd=jelszo;"
Dim oCon: Set oCon = WScript.CreateObject("ADODB.Connection")
Dim oRs: Set oRs = WScript.CreateObject("ADODB.Recordset")
oCon.Open strCon
'Set oRs = oCon.Execute(" SELECT sysdate FROM DUAL union SELECT to_char(sysdate,'YYYYMMDD') FROM DUAL ")
Set oRs = oCon.Execute(" select * from kz_heti_teny where 1=1 and period ='20110129' ")
strExcelPath = "d:\tmp\seredmeny_01.xlsx"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = FALSE
objExcel.ScreenUpdating = FALSE
objExcel.DisplayAlerts = FALSE
Set objWorkbook = objExcel.Workbooks.Add
wscript.echo time
'objExcel.Visible = True
'Set objWorkbook = objExcel.Workbooks.Add
Set objWorksheet = objWorkbook.Worksheets(1)
wscript.echo now & "elso 1"
celx = 1
cely = 0
x = 1
y = 1
'While Not oRs.EOF
do until oRs.EOF
for each eField in oRs.Fields
If x = 1 Then
' fejléc
objExcel.Cells((celx + x - 1), (cely + y )).Value = eField.name
objExcel.Cells((celx + x), (cely + y)).Value = eField.value
else
objExcel.Cells((celx + x), (cely + y)).Value = eField.value
End If
y = y + 1
' WSCript.Echo "Valami-1"
' WSCript.Echo celx
' WSCript.Echo eField.value
next
y = 1
x = x + 1
oRs.MoveNext
'Wend
'WSCript.Echo x
loop
set objWorksheet = objWorkbook.Worksheets(2).Activate
Dim valodi_ketdtomb() 'dynamic array
ReDim valodi_ketdtomb(x-1,oRs.Fields.Count) 'redim 4 rows, 3 cols
oRs.MoveFirst
x = 0
y = 0
do until oRs.EOF
for each eField in oRs.Fields
If x = 0 Then
valodi_ketdtomb(x, y) = eField.value
else
valodi_ketdtomb(x, y) = eField.value
End If
y = y + 1
' WSCript.Echo "Valami-1"
' WSCript.Echo celx
' WSCript.Echo eField.value
next
y = 0
x = x + 1
oRs.MoveNext
'Wend
'WSCript.Echo x
loop
'valodi_ketdtomb=array(null,1,2,3, 4,0,11,22,33,44,0,111,222,333,444,null)
Dim valodi_ketdtomb_regi() 'dynamic array
ReDim valodi_ketdtomb_regi(4,3) 'redim 4 rows, 3 cols
valodi_ketdtomb_regi(0,0) = 1
valodi_ketdtomb_regi(0,1) = 2
valodi_ketdtomb_regi(0,2) = 3
valodi_ketdtomb_regi(1,0) = 10
valodi_ketdtomb_regi(1,1) = 200
valodi_ketdtomb_regi(1,2) = 300
objExcel.Range("E1").Value = oRs.Fields.Count
objExcel.Range("E2").Value = x 'oRs.Records.Count
'Populate by column and row
objExcel.Range("A1:D20").Value = 5
'objExcel.Range("F1:T100").Value= valodi_ketdtomb
objExcel.Range( objExcel.Cells(2,6), objExcel.Cells(x+2,6+oRs.Fields.Count) ).Value = valodi_ketdtomb
objExcel.Range( objExcel.Cells(3,5), objExcel.Cells(5,5) ).Value = "E3-R1C5"
'Range(Cells(3,5),Cells(5,5)).Select
wscript.echo now & "masodik 2"
' XLS megjelenítés
'objExcel.Visible = True
wscript.echo now
' Save the spreadsheet.
'objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
' Quit Excel
objExcel.Application.Quit
wscript.echo now
' Clean up.
adoRecordset.Close
adoConnection.Close
oCon.Close
Set oRs = Nothing
Set oCon = Nothing
wscript.echo now
' --------------- LDAP ---------------
'********************************************************************
'*
'* Copyright Kecskeméti Lajos
'*
'* Module Name: sql_xls.vbs
'*
'* SQL eredmény XLS-be töltése
'*
'*
'*
'********************************************************************
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectClass=user))"
strAttributes = "sAMAccountName, distinguishedName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 10000
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
adoRecordset.MoveFirst
strResults = "User Login Names"
Do Until adoRecordset.EOF
'Retrieve values and display
strName = adoRecordset.Fields("sAMAccountName").Value
strDN = adoRecordset.Fields("distinguishedName").Value
strResults = strResults & VbCrLf & strName & " | " & strDN
adoRecordset.MoveNext
Loop
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("eredmeny.txt", True)
objFile.Write strResults
objFile.Close
Set objFile = Nothing
MsgBox "Elkészültem nézz bele a 'eredmeny.txt' -be."
Használata
cscript sql_xls.vbs
wscript sql_xls.vbs
Megjegyzések
Megjegyzés küldése