Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Access and Access VBA > Access VBA
|
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
 
Old September 18th, 2007, 10:35 AM
Registered User
 
Join Date: Sep 2007
Posts: 5
Thanks: 0
Thanked 0 Times in 0 Posts
Send a message via Yahoo to Calligra
Default 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.
 
Old September 18th, 2007, 12:18 PM
Registered User
 
Join Date: Sep 2007
Posts: 5
Thanks: 0
Thanked 0 Times in 0 Posts
Send a message via Yahoo to Calligra
Default

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
 
Old September 18th, 2007, 12:35 PM
Wrox Author
 
Join Date: Oct 2005
Posts: 4,104
Thanks: 1
Thanked 64 Times in 64 Posts
Send a message via AIM to dparsons
Default

Glad you got it working, next time though, just link to the article from the MySQL forums instead of reposting it. =]

================================================== =========
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

================================================== =========
 
Old September 18th, 2007, 12:40 PM
Registered User
 
Join Date: Sep 2007
Posts: 5
Thanks: 0
Thanked 0 Times in 0 Posts
Send a message via Yahoo to Calligra
Default

Quote:
quote:Originally posted by dparsons
 Glad you got it working, next time though, just link to the article from the MySQL forums instead of reposting it. =]

================================================== =========
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

================================================== =========
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 :)
 
Old September 18th, 2007, 12:55 PM
Wrox Author
 
Join Date: Oct 2005
Posts: 4,104
Thanks: 1
Thanked 64 Times in 64 Posts
Send a message via AIM to dparsons
Default

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

================================================== =========
 
Old September 18th, 2007, 01:05 PM
Registered User
 
Join Date: Sep 2007
Posts: 5
Thanks: 0
Thanked 0 Times in 0 Posts
Send a message via Yahoo to Calligra
Default

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))
 
Old September 19th, 2007, 04:10 PM
Registered User
 
Join Date: Sep 2007
Posts: 5
Thanks: 0
Thanked 0 Times in 0 Posts
Send a message via Yahoo to Calligra
Default

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





Similar Threads
Thread Thread Starter Forum Replies Last Post
Long SQL Query (>1024) in VBA??? mlep Excel VBA 1 June 14th, 2007 08:41 PM
SQL Date query in Excel VBA lanewalk Excel VBA 2 September 27th, 2006 02:04 AM
Help With SQL Query in VBA Paul_Tic Access VBA 4 May 30th, 2006 06:34 AM
SQL Query returns error Raphasevilla Access VBA 2 February 22nd, 2006 08:30 AM
Running an SQL query in VBA... Augusta Access VBA 3 December 1st, 2004 05:17 AM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.