Friday, January 27, 2006

LEFT OUTER JOIN

Option Explicit

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Dim objShell, objFSO, objOutputFile
Dim arr1(),arr2(),arr3(),arr4(),arr5,arr6(),arr7(),arr8()
Dim userDesktop,myFile1,myFile2,myFile3
Dim fullPath1,fullPath2,fullPath3,crapset
Dim strSQL,connString

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

userDesktop = objShell.SpecialFolders("Desktop")
myFile1 = "itemsONLY_not_on_submenus.txt"
myFile2 = "itemsONLY_not_on_modpanels.txt"
myFile3 = "items_niu.txt"
fullPath1 = objFSO.BuildPath(userDesktop,myFile1)
fullPath2 = objFSO.BuildPath(userDesktop,myFile2)
fullPath3 = objFSO.BuildPath(userDesktop,myFile3)

createFile(fullPath1)
'connString = "Provider=SQLNCLI;Server=servername;DataBase=POS;"
connString = "DSN=SQL2005"
strSQL = "SELECT DISTINCT i.ItemId " _
& "FROM Item AS i " _
& "LEFT OUTER JOIN SubMenuItem AS s " _
& "ON i.ItemId = s.ItemId " _
& "WHERE (s.ItemId IS NULL)"
crapset = 1
connect_adodb connString,fullPath1,strSQL,"ItemId",null,null,null,null,null,null,Null
writeToFile arr1,arr2,objOutputFile


createFile(fullPath2)
'connString = "Provider=SQLNCLI;Server=servername;DataBase=POS;"
connString = "DSN=SQL2005"
strSQL = "SELECT DISTINCT i.ItemId " _
& "FROM Item AS i " _
& "LEFT OUTER JOIN SubMenuItem AS s " _
& "ON i.ItemId = s.ItemId " _
& "WHERE (s.ItemId IS NULL)"
crapset = 1
connect_adodb connString,fullPath1,strSQL,"ItemId",null,null,null,null,null,null,Null
writeToFile arr1,arr2,objOutputFile


'Connects to the database, then performs SQL statement
'******************************************************************************
Function connect_adodb(constr,path,sql,r1,r2,r3,r4,r5,r6,r7,r8)

Dim objConnection,objRecordset
Dim i,adUseClient,adPromptAlways
Dim result1,result2,result3,result4,result5,result6,result7,result8

i=0
adUseClient = 3
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open constr
Set objRecordset = CreateObject("ADODB.Recordset")
objRecordset.CursorLocation = adUseClient
objRecordset.Open sql, objConnection,3,3
Do While NOT objRecordset.EOF
Select Case crapset
Case 1
result1 = objRecordset.fields(r1)
ReDim Preserve arr1(i)
arr1(i) = result1
Case 2
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
If result2 = "" Then
result2 = "~~NULL~~"
End If
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
arr1(i) = result1
arr2(i) = result2
Case 3
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
Case 4
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
result4 = objRecordset.fields(r4)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
ReDim Preserve arr4(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
arr4(i) = result4
Case 5
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
result4 = objRecordset.fields(r4)
result5 = objRecordset.fields(r5)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
ReDim Preserve arr4(i)
ReDim Preserve arr5(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
arr4(i) = result4
arr5(i) = result5
Case 6
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
result4 = objRecordset.fields(r4)
result5 = objRecordset.fields(r5)
result6 = objRecordset.fields(r6)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
ReDim Preserve arr4(i)
ReDim Preserve arr5(i)
ReDim Preserve arr6(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
arr4(i) = result4
arr5(i) = result5
arr6(i) = result6
Case 7
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
result4 = objRecordset.fields(r4)
result5 = objRecordset.fields(r5)
result6 = objRecordset.fields(r6)
result7 = objRecordset.fields(r7)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
ReDim Preserve arr4(i)
ReDim Preserve arr5(i)
ReDim Preserve arr6(i)
ReDim Preserve arr7(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
arr4(i) = result4
arr5(i) = result5
arr6(i) = result6
arr7(i) = result7
Case 8
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
result4 = objRecordset.fields(r4)
result5 = objRecordset.fields(r5)
result6 = objRecordset.fields(r6)
result7 = objRecordset.fields(r7)
result8 = objRecordset.fields(r8)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
ReDim Preserve arr4(i)
ReDim Preserve arr5(i)
ReDim Preserve arr6(i)
ReDim Preserve arr7(i)
ReDim Preserve arr8(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
arr4(i) = result4
arr5(i) = result5
arr6(i) = result6
arr7(i) = result7
arr8(i) = result8
End Select
i = i + 1
objRecordset.MoveNext
Loop

MsgBox "End of Query",0,"End"

If result1 = empty Then
MsgBox "No records",0,"No Records Returned"
End If

End Function
'********************************************|

'******************************************************
Function createFile(path)

Set objOutputFile = objFSO.CreateTextFile(path,True)

End Function
' ********************************************|


'*******************************************************
Function writeToFile(arr01,arr02,path)

Dim x, strText

Select Case crapset
Case 1
For x=0 To UBound(arr01)
strText = arr01(x) & vbCr
path.WriteLine strText
path.WriteLine "------------------"
Next
Case 2
For x=0 To UBound(arr01)
strText = arr01(x) & vbTab & arr02(x) _
& vbCr
path.WriteLine strText
Next
'#############HTML Format ######################
' For x=0 To UBound(arr01)
' strText = "pre" & arr01(x) & vbTab & arr02(x) _
' & "br-----------------------br/pre"
' path.WriteLine strText
' Next
'#############HTML Format ######################
Case 3
For x=0 To UBound(arr01)
strText = arr01(x)
path.WriteLine strText
Next
End Select

path.Close

End Function
'*********************************************|

'*******************************************************
Sub quitscript

MsgBox "Quitting Now"
Wscript.Quit

End Sub
'*********************************************|

No comments:

Post a Comment