SQL WHERE STATEMENT

**khalid79m** · 11-16-2011, 03:58 AM

[vba]Option Explicit
Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
Dim rsCon As Object
Dim rsData As Object
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long
If Header = False Then
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No"";"
End If
Else
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
End If
End If
If SourceSheet = "" Then
szSQL = "SELECT * FROM " & SourceRange$ & ";"
Else
szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
End If
On Error GoTo SomethingWrong
Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")
rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1

If Not rsData.EOF Then
If Header = False Then
TargetRange.Cells(1, 1).CopyFromRecordset rsData
Else
If UseHeaderRow Then
For lCount = 0 To rsData.Fields.Count - 1
TargetRange.Cells(1, 1 + lCount).Value = _
rsData.Fields(lCount).Name
Next lCount
TargetRange.Cells(2, 1).CopyFromRecordset rsData
Else
TargetRange.Cells(1, 1).CopyFromRecordset rsData
End If
End If
Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If
rsData.Close
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing
Exit Sub
SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0
End Sub[/vba]

I have a problem with this line ,
[vba]szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
[/vba]

how can I get it to do a where KEY5 = 10 , the Key 5 data source range is f1:f1000

the code to run the function is

[vba]GetData FullP, X2, "A1:CA1000", ThisWorkbook.Sheets("ss" & PGI).Range("A1"), True, True[/vba]

Can anyone help

**Aflatoon** · 11-16-2011, 05:01 AM

Just adding the WHERE clause:

[vba]szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "] WHERE [KEY5] = 10;"[/vba]

should work since you have headers in the data.

**khalid79m** · 11-16-2011, 05:21 AM

[VBA]szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "] WHERE [KEY5] = 10;"[/VBA]

this works but when I try this it fails

[VBA]szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "] WHERE [Team_Leader] = XAZ80;"[/VBA]

Is this because this is a text and numeric field if so how can i get it to work?

**Aflatoon** · 11-16-2011, 05:29 AM

Yes - for a text field you need the ' delimiter:
[vba]szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "] WHERE [Team_Leader] = 'XAZ80';"[/vba]

**khalid79m** · 11-16-2011, 05:51 AM

[VBA]szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "] WHERE [Team_Leader] = 'SAH01';"[/VBA]

this now works by adding single quotes.

Now how can I get to work with variable value, for example x = SAH10 then how to I get this to work in the single quotes

[VBA]szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "] WHERE [Team_Leader] = '[x]';"[/VBA]

**khalid79m** · 11-16-2011, 08:07 AM

[VBA] szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "] WHERE [Team_Leader] = '" & "" & X & "" & "';"[/VBA]

**Aflatoon** · 11-16-2011, 08:15 AM

No need for the "":
[vba]szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "] WHERE [Team_Leader] = '" & X & "';" [/vba]

**khalid79m** · 11-16-2011, 08:39 AM

okay will try that , how can i now convert this code to work with .txt file

[VBA]Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
'Get Value
Dim Z1$, Z2$, X1$, X2$
Z1 = ThisWorkbook.Sheets("CD").Range("UD_05ROL").Value
Z2 = InStr(Z1, " ")
Z1 = Mid(Z1, 1, Z2 - 1)
' 30-Dec-2007, working in Excel 2000-2007
Dim rsCon As Object
Dim rsData As Object
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long
' Create the connection string.
If Header = False Then
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No"";"
End If
Else
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
End If
End If
If SourceSheet = "" Then
szSQL = "SELECT * FROM " & SourceRange$ & ";"
Else
'Dim X
'X = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "] WHERE [Team_Leader] = '" & "" & Z1 & "" & "';"
szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "] WHERE [Oracle_Role] = '" & "" & Z1 & "" & "';"
End If
On Error GoTo SomethingWrong
Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")
rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1
If Not rsData.EOF Then
If Header = False Then
TargetRange.Cells(1, 1).CopyFromRecordset rsData
Else
If UseHeaderRow Then
For lCount = 0 To rsData.Fields.Count - 1
TargetRange.Cells(1, 1 + lCount).Value = _
rsData.Fields(lCount).Name
Next lCount
TargetRange.Cells(2, 1).CopyFromRecordset rsData
Else
TargetRange.Cells(1, 1).CopyFromRecordset rsData
End If
End If
Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If
rsData.Close
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing
Exit Sub
SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0
End Sub
[/VBA]

AND THE CODE

[VBA]
GetData FullP, X2, "A1:CA1000", ThisWorkbook.Sheets("Data_TL" & PGI).Range("A1"), True, True

[/VBA]

I was initially told it would be .xls file but in fact its a .txt file

can you help because i bearly understand the code

**Aflatoon** · 11-16-2011, 08:45 AM

What format is the text file?

**khalid79m** · 11-16-2011, 02:16 PM

Hi thanks for your help.. I have attached a zip containing a control file and the same data file in .xls .txt and .csv. The control file has the relevant code to connect to all 3 data types I have got the .xls working like a dream thanks to your tweeks but the .txt and .csv I have no idea what im doing wrong. The .txt one is they most important.

It would be great if u could assit with .csv time permitting of course. Then I would have a good template for future and something I can share with fellow vba community.

Ideally code needs to connect to .txt and use the where statement sql

Thanks

**khalid79m** · 11-17-2011, 04:58 AM

aflatoon , its a tabdelimited .txt

**Aflatoon** · 11-17-2011, 07:56 AM

Well, since it is tab delimited, rather than comma delimited, you need to either use a schema.ini file or modify the registry. The former is simpler so I have added some code to create the necessary schema file, and altered the function to work with text files:
[vba]Option Explicit
Sub GetData_Example1()
Dim FullP, Inx, Oux, TimeX

Inx = Now()

FullP = Workbooks("Control.xls").Path & "\TL1.txt" 'this is within the folder

'Workbooks.Open FullP
'' IF YOU OPEN THE WORKBOOK USING THE WORKBOOK OPEN COMMAND THE WORKBOOK OPENS YET WHEN YOU USE THE ADO THERE IS AN ERROR

GetTextData FullP, ThisWorkbook.Sheets("ADOTXT").Range("A1"), True, True

Oux = Now()

TimeX = Format(Oux - Inx, "HH:MM:SS")
MsgBox TimeX

ThisWorkbook.Sheets("ADOTXT").Select
End Sub
Public Sub GetTextData(SourceFile As Variant, _
TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)

' 30-Dec-2007, working in Excel 2000-2007
Dim rsCon As Object
Dim rsData As Object
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long
Dim szFolder As String
Dim szFileName As String
Dim lPathSep As Long

lPathSep = InStrRev(SourceFile, "\")
szFolder = Left(SourceFile, lPathSep)
szFileName = Mid$(SourceFile, lPathSep + 1)

CreateSchemaFile szFolder, szFileName
' Get the right connection
If Header = False Then
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & szFolder & ";" & _
"Extended Properties='text;HDR=NO;FMT=Delimited';"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & szFolder & ";" & _
"Extended Properties='text;HDR=NO;FMT=Delimited';"
End If
Else
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & szFolder & ";" & _
"Extended Properties='text;HDR=YES;FMT=Delimited';"
Else
'szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
'"Data Source=" & SourceFile & ";" & _
'"Extended Properties=""Excel 12.0;HDR=Yes"";"

szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & szFolder & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
End If
End If

szSQL = "SELECT * FROM [" & szFileName & "]" ' WHERE [Who] = 'Me';"

On Error GoTo SomethingWrong

Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")

rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1

If Not rsData.EOF Then

If Header = False Then
TargetRange.Cells(1, 1).CopyFromRecordset rsData
Else
If UseHeaderRow Then
For lCount = 0 To rsData.Fields.Count - 1
TargetRange.Cells(1, 1 + lCount).Value = _
rsData.Fields(lCount).Name
Next lCount
TargetRange.Cells(2, 1).CopyFromRecordset rsData
Else
TargetRange.Cells(1, 1).CopyFromRecordset rsData
End If
End If

Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If

rsData.Close
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing
Exit Sub

SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0

End Sub

Sub CreateSchemaFile(szFolder As String, szFileName As String)
Open szFolder & "Schema.ini" For Output As #1
Print #1, "[" & szFileName & "]"
Print #1, "Format=TabDelimited"
Close #1
End Sub
[/vba]

Please let me know how it works.

**khalid79m** · 11-17-2011, 09:21 AM

Thanks for your response, I will check it first thing tommorrow and let you know.

Thanks

**khalid79m** · 11-17-2011, 10:10 AM

Hi Just asigned on to test it, the code works like a dream however, i have a problem , well you might be able to correct me on this.

This code will sit in an interactive excel dashboard, which the users will select what they want and the code will get the data from the txt. There are 5 .txts it will loop thru, what impact will this have on the schema if more than 1 person is running the code?

Say person 1 has run this code and its on file TL3 so shceme will be TL3 and another person runs the code they will change the scheme back to tl1 right ?

Thanks Muneer

**khalid79m** · 11-17-2011, 10:12 AM

[VBA]Sub CreateSchemaFile(szFolder As String, szFileName As String)
Open szFolder & "Schema.ini" For Output As #1
Print #1, "[" & szFileName & "]"
Print #1, "Format=TabDelimited"
Close #1
End Sub[/VBA]

could the file name be left of the scheme and put in the other bit of the code or does it have to be in the shceme?

**Aflatoon** · 11-17-2011, 10:51 AM

It might be easier for you to change registry settings, unless you can alter the txt to comma delimited.
In any event, I am afraid that is as much time as I can invest in one question.

**khalid79m** · 11-18-2011, 03:29 AM

i have work around. thanks for your time

Thread: SQL WHERE STATEMENT

Thread Tools

Display

SQL WHERE STATEMENT

Error

Help

Sample File

Posting Permissions