 |
Access VBA Discuss using VBA for Access programming. |
Welcome to the p2p.wrox.com Forums.
You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
|
|
|

September 18th, 2007, 10:35 AM
|
Registered User
|
|
Join Date: Sep 2007
Posts: 5
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
VBA - SQL query returns nothing from MySQL
I've spent the past 3 days working with MySQL and vba within the Excel spreadsheet attempting to utilize a sql query within my code to see if the value within the column "thetext" is contained within a cell within the worksheet. Any assistance would be greatly appreciated!
If I put the following code into mySQLCC, the command works just as desired and the paragraph starting with "There may" is returned:
set @MyMessage := "Running Opera V8.52 on Suse Linux 10.1 menus do not appear. The sub window
for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.
There may be more bugs than this. Bryan initially wrote his stuff with only
firefox and IE as targets. Running Opera V8.52 on Suse Linux 10.1 menus do not appear. The sub
window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.";
SELECT thetext FROM longdescs WHERE thetext in (SELECT thetext FROM longdescs WHERE (507 =
bug_id AND 20070704 <= bug_when AND thetext NOT LIKE "%" + @MyMessage + "%"))
In the attempt to utilize the same statement within my vba code, I cannot get a return of any values:
myString = .Cells(irow, 17).Formula
vSQL = "SELECT thetext FROM longdescs WHERE thetext in (SELECT thetext FROM longdescs WHERE ( thetext LIKE ""%" & Left(myString, Len(myString) - 2) & "%"" AND " & myBug & " = bug_id AND " & myDay & " <= bug_when))"
NOR
vSQL = "SELECT thetext FROM longdescs WHERE thetext in (SELECT thetext FROM longdescs WHERE ( thetext LIKE ""*" & Left(myString, Len(myString) - 2) & "*"" AND " & myBug & " = bug_id AND " & myDay & " <= bug_when))"
NOR
vSQL = "SET @MyMessage := """ & Left(myString, Len(myString) - 2) & """;" & Chr(10) & Chr(13)
vSQL = vSQL & "SELECT thetext FROM longdescs WHERE thetext in (SELECT thetext FROM longdescs WHERE (thetext LIKE ""%"" + @MyMessage + ""%"" AND " & myBug & " = bug_id AND " & myDay & " <= bug_when))"
The last statement just return a SQL error.
|

September 18th, 2007, 12:18 PM
|
Registered User
|
|
Join Date: Sep 2007
Posts: 5
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
The resolved information is as follows:
For the one that gives the -2147217900 error the query is as thus:
: myDay : 20070704000000 : Double
: myDate : #7/4/2007# : Date
: myBug : 507 : Integer
: myString : "Running Opera on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.
------- Additional Comment #1 From Jeremy 2007-07-09 14:23 [reply] -------
There may be more bugs than this. Bryan initially wrote his stuff with only
firefox and IE as targets. Running Opera on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go."
SET @MyMessage := "Running Opera on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.
------- Additional Comment #1 From Jeremy 2007-07-09 14:23 [reply] -------
There may be more bugs than this. Bryan initially wrote his stuff with only
firefox and IE as targets. Running Opera on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.";
SELECT thetext FROM longdescs WHERE thetext in (SELECT thetext FROM longdescs WHERE (thetext LIKE "% + @MyMessage + %" AND 507 = bug_id AND 20070704000000 <= bug_when))
The query which returns nothing when the verbiage "There may be more bugs...." is as follows:
SELECT thetext FROM longdescs WHERE thetext in (SELECT thetext FROM longdescs WHERE ( thetext LIKE "%Running Opera on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.
------- Additional Comment #1 From Jeremy 2007-07-09 14:23 [reply] -------
There may be more bugs than this. Bryan initially wrote his stuff with only
firefox and IE as targets. Running Opera on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.%" AND 507 = bug_id AND 20070704000000 <= bug_when))
OR
SELECT thetext FROM longdescs WHERE thetext in (SELECT thetext FROM longdescs WHERE ( thetext LIKE "*Running Opera on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.
------- Additional Comment #1 From Jeremy 2007-07-09 14:23 [reply] -------
There may be more bugs than this. Bryan initially wrote his stuff with only
firefox and IE as targets. Running Opera on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.*" AND 507 = bug_id AND 20070704000000 <= bug_when))
The entire code is as follows:
Function MyTestConnection()
Dim conn As adodb.Connection
Dim rs3 As adodb.Recordset
Dim myDay As Double
Dim myDate As Date
Dim myBug As Integer
Set conn = New adodb.Connection
conn.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" _
& "SERVER=servername;" _
& "DATABASE=dbname;" _
& "UID=uid;" _
& "PWD=password;"
conn.CursorLocation = adUseClient
conn.Open
myDate = Now
myDate = DatePart("yyyy", myDate) & "/" & DatePart("m", myDate) - 2 & "/" & DatePart("d", myDate) - 14
myDay = Format(myDate, "yyyymmddhhmmss")
myBug = 507
Set rs3 = New adodb.Recordset
With Sheet17
If .Cells(ActiveCell.Row, 1).Value = myBug And ActiveSheet.CodeName = "Sheet17" Then
irow = ActiveCell.Row
Else
Sheet17.Activate
Cells.Find(What:=myBug, After:=Range("A1"), LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
If Err = 91 Then
Err = 0
Cells.Find(What:=myBug, After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
If Err = 91 Then
Exit Function
Else
irow = ActiveCell.Row
End If
Else
irow = ActiveCell.Row
End If
End If
mystring = .Cells(irow, 17).Formula
If rs3.State = 1 Then
rs3.Close
End If
vSQL = "SET @MyMessage := """ & Left(mystring, Len(mystring) - 2) & """;" & Chr(10) & Chr(13)
vSQL = vSQL & "SELECT thetext FROM longdescs WHERE thetext in (SELECT thetext FROM longdescs WHERE (thetext LIKE ""% + @MyMessage + %"" AND " & myBug & " = bug_id AND " & myDay & " <= bug_when))"
vSQL = "SELECT thetext FROM longdescs WHERE thetext in (SELECT thetext FROM longdescs WHERE ( thetext LIKE ""%" & Left(mystring, Len(mystring) - 2) & "%"" AND " & myBug & " = bug_id AND " & myDay & " <= bug_when))"
MsgBox vSQL
Err = 0
On Error Resume Next
rs3.Open vSQL, conn, , , adCmdText
Do Until rs3.EOF
.Cells(irow, 17).Formula = .Cells(irow, 17).Formula & rs3.Fields("thetext") & Chr(10) & Chr(10)
rs3.MoveNext
Loop
End With
rs3.Close
wrkODBC.Close
Set rs3 = Nothing
Set wrkODBC = Nothing
Set Dcon = Nothing
End Function
|

September 18th, 2007, 12:40 PM
|
Registered User
|
|
Join Date: Sep 2007
Posts: 5
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
Ummm I have NOT gotten it working (durn it!) I was just adding the resolved variables to the message so as to hopefully get some assistance with this issue... HELP :)
|

September 18th, 2007, 12:55 PM
|
Wrox Author
|
|
Join Date: Oct 2005
Posts: 4,104
Thanks: 1
Thanked 64 Times in 64 Posts
|
|
I see. You probably should not of lead your post with: The resolved information is as follows: as I assumed the post from the MySQL forum had resolved your error.
What is the string literal of your SQL Statements once your variables have been evaluated?
================================================== =========
Read this if you want to know how to get a correct reply for your question:
http://www.catb.org/~esr/faqs/smart-questions.html
================================================== =========
Technical Editor for:
Professional Search Engine Optimization with ASP.NET
Professional IIS 7 and ASP.NET Integrated Programming
================================================== =========
|

September 18th, 2007, 01:05 PM
|
Registered User
|
|
Join Date: Sep 2007
Posts: 5
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
The information that you're requesting is in my second post. I have 3 attempted statements.
1. The one below works flawlessly in the MySQLCC application but returns a -2147217900 during the VBA conversion process:
SET @MyMessage := "Running Opera on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.
------- Additional Comment #1 From Jeremy 2007-07-09 14:23 [reply] -------
There may be more bugs than this. Bryan initially wrote his stuff with only
firefox and IE as targets. Running Opera V8.52 on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.";
SELECT thetext FROM longdescs WHERE thetext LIKE "%" + @MyMessage + "%" AND 507 = bug_id AND 20070704000000 <= bug_when
2. The next two queries, although don't return an error, they do not return the record starting with "There may be more bugs..." as expected. Instead they return an empty record set.
SELECT thetext FROM longdescs WHERE thetext in (SELECT thetext FROM longdescs WHERE ( thetext LIKE "%Running Opera on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.
------- Additional Comment #1 From Jeremy 2007-07-09 14:23 [reply] -------
There may be more bugs than this. Bryan initially wrote his stuff with only
firefox and IE as targets. Running Opera on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.%" AND 507 = bug_id AND 20070704000000 <= bug_when))
AND
SELECT thetext FROM longdescs WHERE thetext in (SELECT thetext FROM longdescs WHERE ( thetext LIKE "%Running Opera V8.52 on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.
------- Additional Comment #1 From Jeremy 2007-07-09 14:23 [reply] -------
There may be more bugs than this. Bryan initially wrote his stuff with only
firefox and IE as targets. Running Opera V8.52 on Suse Linux 10.1 menus do not appear. The sub window for
the menu is drawn. No select actions take place, i.e. clicking on where a menu
entry should be does nothing. For instance you cannot logout via the last menu
entry. Sometimes if you click fast enough you can get a menu item to go.%" AND 507 = bug_id AND 20070704000000 <= bug_when))
|

September 19th, 2007, 04:10 PM
|
Registered User
|
|
Join Date: Sep 2007
Posts: 5
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
Although I still have no clue as why this query returns no values from the DB, I do thank everyone that tried to assist. I have found a work around to my problem. Basically I had to split the cell up into fragments and then do a direct one to one comparison with each record. Not very elegant but seems to be working great. The code is as follows:
Dim conn As ADODB.Connection
Dim rs2 As ADODB.Recordset
Dim vSQL As String
Dim myDay As Double
Dim myDate As Date
Dim myBug As Integer
Dim myString As String
Dim myFieldValue As String
Dim i, i2, iRow, strLen, itemp As Long
Dim x As Integer
Dim myText() As String
Dim myChar As String
Dim vBool As Boolean
Set conn = New ADODB.Connection
conn.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" _
& "SERVER=server;" _
& "DATABASE=dbname;" _
& "UID=uid;" _
& "PWD=password;"
conn.CursorLocation = adUseClient
conn.Open
myDate = Now
myDate = DatePart("yyyy", myDate) & "/" & DatePart("m", myDate) - 2 & "/" & DatePart("d", myDate) - 15
myDay = Format(myDate, "yyyymmddhhmmss")
myBug = 49
vSQL = "SELECT LD.thetext, LD.bug_when, P.realname FROM longdescs LD, profiles P WHERE " & myBug & " = LD.bug_id"
Set rs2 = New ADODB.Recordset
On Error Resume Next
rs2.Open vSQL, conn, , , adCmdText
With Sheet17
If .Cells(ActiveCell.Row, 1).Value = myBug And ActiveSheet.CodeName = "Sheet17" Then
iRow = ActiveCell.Row
Else
Sheet17.Activate
Cells.Find(What:=myBug, After:=Range("A1"), LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
If Err = 91 Then
Err = 0
Cells.Find(What:=myBug, After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
If Err = 91 Then
' GoTo Label1
Else
iRow = ActiveCell.Row
End If
Else
iRow = ActiveCell.Row
End If
End If
For i = 1 To 1000
myString = myString & .Cells(iRow, 17).Value
If .Cells(iRow + i, 2).Value <> "" Then
Exit For
End If
Next i
'Clean out the extraneous chr(10)'s
If myString Like "*" & Chr(10) & Chr(10) & "*" Then
'Count the number of Chr(10)'s in the string
strLen = Len(myString)
ReDim myText(0)
x = 0
For i = 1 To strLen
If i = 1 Then
myChar = Right(Left(myString, i), strLen - i)
Else
myChar = Right(Right(Left(myString, i), strLen - i), i - (i - 1))
End If
If (myChar = Chr(10) And (Right(Right(Left(myString, i + 1), strLen - (i + 1)), (i + 1) - ((i + 1) - 1)) = Chr(10) And (Right(Right(Left(myString, i + 2), strLen - (i + 2)), (i + 2) - ((i + 2) - 1)) = "-")) Or i = strLen - 1) Then
If (i <> strLen - 1) And (i + 2 <> strLen) Then
i = i + 2
End If
If x = 0 Then
myText(x) = Left(myString, i - 3)
ElseIf (i <> strLen - 1) And (i + 2 <> strLen) Then
myText(x) = Right(Left(myString, i - 3), (i - 2) - (i2 + 1))
Else
itemp = Len(Right(Left(myString, i - (strLen - i)), ((i - (strLen - i)) - i2)))
myText(x) = Right(Left(myString, i - (strLen - i)), ((i - (strLen - i)) - i2))
End If
If (i + 2 <> strLen) And (i + 1 <> strLen) Then
x = x + 1
ReDim Preserve myText(x)
'Progress i until all of the comment field has been passed
For i2 = i To strLen
If Right(Right(Left(myString, i2), strLen - i2), i2 - (i2 - 1)) = Chr(10) And Right(Right(Left(myString, (i2 - 2)), strLen - (i2 - 2)), (i2 - 2) - ((i2 - 2) - 1)) = "-" Then
i = i2
Exit For
End If
Next i2
Else
i = strLen
End If
End If
Next i
End If
Do Until rs2.EOF
vBool = False
If skipBool = False Then
For x = 0 To UBound(myText)
If rs2!thetext = Left(myText(x), Len(myText(x)) - 1) Or rs2!thetext = myText(x) Then
vBool = True
rs2.MoveNext
Else
vBool = False
End If
Next x
If (x - 1 = UBound(myText)) And vBool = True Then skipBool = True
End If
If vBool = False Then 'No match was found so write new file
Err = 0
If .Cells(iRow, 17).Value = "" Then
.Cells(iRow, 17).Formula = rs2.Fields("thetext") & Chr(10) & Chr(10)
Else
.Cells(iRow, 17).Formula = .Cells(iRow, 17).Formula & "------- Additional Comment #" & rs2.AbsolutePosition & " From " & rs2!realname & " " & Format(rs2!bug_when, "yyyy-mm-dd hh:mm") & " [reply] -------" & Chr(10) & rs2.Fields("thetext") & Chr(10) & Chr(10)
If Err = 1004 Then 'The cell is full and record must be written to new line
Err = 0
Rows(iRow + 1 & ":" & iRow + 1).Insert Shift:=xlDown
iRow = iRow + 1
.Cells(iRow, 17).Formula = .Cells(iRow, 17).Formula & "------- Additional Comment #" & rs2.AbsolutePosition & " From " & rs2!realname & " " & Format(rs2!bug_when, "yyyy-mm-dd hh:mm") & " [reply] -------" & Chr(10) & rs2.Fields("thetext") & Chr(10) & Chr(10)
End If
End If
End If
rs2.MoveNext
Loop
On Error Resume Next
End With
rs2.Close
conn.Close
Set rs2 = Nothing
Set conn = Nothing
End Sub
|
|
 |