Do
Searchdata = InputBox("Please enter the Value", "Input")
Loop Until Searchdata = ""

cnstring = "Provider=SQLOLEDB.1;Password=PASSWORD;Persist Security Info=True;User ID=USERNAME;Initial Catalog=USERNAME;Data Source=192.168.2.2;"
cmdtext = "SELECT * FROM DATABASE where FIELD_NAME = "& Searchdata &""
Set cn = CreateObject("adodb.connection")
Set cmd = CreateObject("adodb.command")
cn.connectionstring = cnstring
cn.Open
cmd.activeconnection = cn
cmd.commandtext = cmdtext

Set rs = CreateObject("adodb.recordset")
rs.cursortype = 3
rs.locktype = 3
rs.Open(cmd)
While Not rs.EOF And Not rs.BOF
'WScript.Echo rs.Fields.Item("FIELD_NAME").Value
Data = rs.Fields.Item("FIELD_NAME").Value
'WScript.Echo  Data

rs.MoveNext
Wend
rs.Close
cn.Close
If Data = "" Then
WScript.Echo "Ta Dedomena den Yparxoun sti Vasi"

answer=MsgBox ("Do you want to Add the "& Data  &" ", 36, "ADD THE VALUE ")
If answer = 6 Then

cnstring = "Provider=SQLOLEDB.1;Password=PASSWORD;Persist Security Info=True;User ID=USERNAME;Initial Catalog=USERNAME;Data Source=192.168.2.2;"
cmdtext = "INSERT INTO DATABASE (FIELD_NAME) VALUES (" & Data & ")"
Set cn = CreateObject("adodb.connection")
Set cmd = CreateObject("adodb.command")
cn.connectionstring = cnstring
cn.Open
cmd.activeconnection = cn
cmd.commandtext = cmdtext

cmd.Execute
cn.Close

WScript.Quit
Else
WScript.echo "NO"

WScript.Quit
End If
Else
WScript.Echo "Ta Dedomena Yparxoun Sti Vasi"

End If

set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
set oUrlLink = WshShell.CreateShortcut(strDesktop & "\Install.gr")
oUrlLink.TargetPath = "http://www.install.gr"
oUrlLink.Save

' *  VBScript Find Windows Install Date
' *  Version:  1.0
' *
' *  Enjoy!

Set OSSet = GetObject("winmgmts://." _
& "/root/cimv2").ExecQuery("select * from Win32_OperatingSystem")
For Each OS In OSSet
wscript.echo FormatUTime(OS.InstallDate)
Next
'-----------------------------------------
'Format "Universal Time" to DD.MM.YY HH:MM
'-----------------------------------------
Function FormatUTime (S)
FormatUTime = Mid(S, 7, 2) & "." & Mid(S, 5, 2) & "." & Mid(S, 3, 2) _
& " " &  Mid (S, 9, 2) & ":" & Mid(S, 11, 2) & " "
End Function

' *  VBScript to change the IE Proxy Server, by directly editing the registry
' *  Version:  2.1.1
' * Edit From Nick Drosinis
' * Change Log:
' *
' * Added:
' * Inputbox for Proxy Address
' * Check Current Proxy Settings
' *
' *  Enjoy!

'Option Explicit

' *  Proxy Server

dim strComputer
strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2\Applications\MicrosoftIE")
'Display Proxy settings og Internet Explorer
Set colIESettings = objWMIService.ExecQuery ("Select * from MicrosoftIE_LANSettings")
For Each strIESetting In colIESettings

ProxyServer = ""& strIESetting.ProxyServer&""
Next

wscript.echo "Current Internet Explorer Proxy:" & ProxyServer

Dim proxy

Do
proxy = inputbox("Please enter the new proxy address (ex:192.168.10.10:8080)", "Input")
loop until proxy > ""

' *  Application Title

Dim Title
Title = "Los Proxy Changer"

' *  Welcome Message

Dim Welcome_Text
Welcome_Text = "Do you really want to change the Proxy Server to " & proxy & "?"

Call Welcome()

Sub Welcome()
Dim GO
GO = MsgBox(Welcome_Text, 36, Title)
If GO = 7 Then
WScript.Quit
End If
End Sub

' *  Warning Message

Dim Warning_Text
Warning_Text = "Warning:  All current Internet Explorer and Windows Explorer windows will be closed." & Chr(10) _
& Chr(10) _
& "Do you still wish to continue?"

Call Warning()

Sub Warning()
Dim GO
GO = MsgBox(Warning_Text, 36, Title)
If GO = 7 Then
WScript.Quit
End If
End Sub

' *  WSHShell

Dim WSHShell
Set WSHShell = WScript.CreateObject("WScript.Shell")

' *  Kill IE (and consequently WE as well)

Call Kill_IE()

Sub Kill_IE()
While WSHShell.AppActivate("Internet Explorer")
WSHShell.SendKeys "%{F4}"
WScript.Sleep 500    ' Impedes a traffic jam
WEnd
End Sub

' *  Regedits

WSHShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable", 1, "REG_DWORD"
WSHShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyServer", proxy
WSHShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyOverride", ""
WSHShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\DisablePasswordCaching", 1, "REG_DWORD"

' *  Confirmation

Dim confirm
confirm = MsgBox("Proxy Server has been changed to " & proxy & ".  Enjoy.", 64, Title)

' *  Open IE

WSHShell.run "iexplore.exe http://www.install.gr"

WScript.echo "Warning This Script will Use The Default PST Format Supported by The Version of Outlook Your Using. Pre Outlook 2003 Supports A max" &_
" PST Size of 2gig.  Outlook 2003 or Greater Supports PST files over 2gig.  A Registry Change May Be Necessary to Allow Extremely Large PST Files in Unicode To Be Created"

' defined for future use if needed
Const olFolderDeletedItems = 3
Const olFolderOutbox = 4
Const olFolderSentMail = 5
Const olFolderInbox = 6
Const olFolderCalendar = 9
Const olFolderContacts = 10
Const olFolderJournal = 11
Const olFolderNotes = 12
Const olFolderTasks = 13
Const olFolderDrafts = 16

'PST Constants
Const olStoreDefault = 1    ' Supports Default Pst Type for Version of Outlook
Const olStoreUnicode =2     ' Enables Support for Unicode PST Files that can Grow in Excess of 2gig
Const olStoreANSI = 3       ' Enables Ansi Support for pre outlook 2003 versions that support pst files of no more then 2gig

Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")

'Get user's name
Set objNetwork = WScript.CreateObject("WScript.Network")

strUserName = objNetwork.UserName

'create pst add user name
Dim WshShell : Set WshShell = WScript.CreateObject( "WScript.Shell" )
Dim objFSO : Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

' PST Folder Path
OutlookFolder = "C:\Outlook"

'Create Folder if it Doesn't Exist
If Not objFSO.FolderExists(OutlookFolder) Then
Set oFolder = objFSO.CreateFolder (OutlookFolder)
End If

' Check version of office before creating .Pst
sComputer = "."
iOfficeVer = GetOfficeVer(sComputer)
If iOfficeVer = -1 Then
WScript.Echo "Version of Office installed is unknown, " & "could not connect to the remote computer."

ElseIf iOfficeVer = 0 Then
WScript.Echo "Office is not installed."
Else
WScript.Echo "Version of Office installed: " & iOfficeVer
End If

'Create .Pst file as Username in The Outlook folder

If iOfficeVer = "2007" Then
objNameSpace.AddStoreEx OutlookFolder & "\" & objNameSpace.CurrentUser & ".pst",olStoreDefault

Else
objNameSpace.AddStoreEX OutlookFolder & "\" & objNameSpace.CurrentUser & ".pst",olStoreDefault

End If

strpstFolder = objnamespace.currentuser

strdisplayname = "Exported Mailbox"

'Renames PST File To Unique Display Name
Set pstrename = objNameSpace.Folders.GetLast
pstrename.name = strdisplayname

'Recycle pst mount to get display name to appear if not office 2007
If iOfficeVer <> "2007" Then
objNamespace.RemoveStore pstrename ' Step 1 to refresh folder tree view
objNamespace.AddStore outlookfolder & "\" & strpstfolder & ".pst" ' Step 2 to refresh folder tree view
end if
'Bind to Pst File
Set pstfoldermount = objNameSpace.folders(strdisplayname)
pstroot = pstfoldermount.name
'Set Namspace to Default Mailbox Inbox Folder
Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
strFolderName = objInbox.Parent

'Sets Default to Mailbox Root vs Inbox. Must bind to inbox like above first Before Parent Below this is by design
Set objMailbox = objNamespace.Folders(strFolderName)

'set collection for mailbox contents at root
Set colFolders = objMailbox.Folders

For Each objFolder In colFolders

If LCase(objfolder.name) = LCase("Deleted Items") Then
Set objmailboxfolder = objmailbox.folders(objfolder.name)
Set objPstFolder = objNameSpace.folders(pstroot)
Set objPstDeleted = objPstFolder.folders("Deleted Items")
Set copyFolder = objmailboxfolder.CopyTo(objPstdeleted)

Else

Set objmailboxfolder = objmailbox.folders(objfolder.name)
Set objPstFolder = objNameSpace.folders(pstroot)
Set copyFolder = objmailboxfolder.CopyTo(objPstFolder)

End If

Next

' sub Dismount PST

get_DismountPST()

WScript.echo "Outlook/Exchange Mailbox Export To PST File Completed.  PST Has Been Dismounted and is Located in C:\outlook Directory"

'******************* FUNCTIONS and Subs *************************************************************

'*** Sub Dismount PST ******
Sub get_DismountPST()

Set myOlApp = CreateObject("Outlook.Application")
Set myNS = myolapp.GetNamespace("MAPI")
set pstfolder = myns.folders("Exported Mailbox")

myNS.removeStore pstfolder

End sub

'*** Function

Function GetOfficeVer(sNode)
On Error Resume Next
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sNode & "/root/default:StdRegProv")
If Err.Number <> 0 Then
GetOfficeVer = -1
Exit Function  '------->
End If
sValueName = "Path"
sRegPre = "SOFTWARE\Microsoft\Office\"
sRegPost = "\Common\InstallRoot"

If oReg.GetStringValue(HKLM, sRegPre & "12.0" & sRegPost, sValueName, sValue) = 0 Then
GetOfficeVer = 2007
ElseIf oReg.GetStringValue(HKLM, sRegPre & "11.0" & sRegPost, sValueName, sValue) = 0 Then
GetOfficeVer = 2003
ElseIf oReg.GetStringValue(HKLM, sRegPre & "10.0" & sRegPost, sValueName, sValue) = 0 Then
GetOfficeVer = 2002
ElseIf oReg.GetStringValue(HKLM, sRegPre & "9.0" & sRegPost, sValueName, sValue) = 0 Then
GetOfficeVer = 2000
ElseIf oReg.GetStringValue(HKLM, sRegPre & "8.0" & sRegPost, sValueName, sValue) = 0 Then
GetOfficeVer = 97
Else
GetOfficeVer = 0
End If
End Function