Option Compare Database

Option Explicit

Private Sub LoadControlPanel_Click()

   WebBrowser1.Navigate2 "http://192.168.192.1/~stew/mysql/mysql_dump.php"

End Sub

Function Clear_Table(tablename)

    Dim mydb As Database

    Dim wrkDefault As Workspace

    Dim mySQL As String

    Set mydb = CurrentDb

    Set wrkDefault = DBEngine.Workspaces(0)

    mySQL = "DELETE * FROM " & tablename

    'run the DELETE statement

    On Error GoTo Err_Execute

    wrkDefault.BeginTrans

    mydb.Execute mySQL, dbFailOnError

    wrkDefault.CommitTrans

    On Error GoTo 0

Success:

    Clear_Table = 1

    Exit Function

Err_Execute:

    Clear_Table = 0

    Exit Function

End Function

Function Append_MySQL_To_Table(tablename, buff)

    Dim mydb As Database

    Dim wrkDefault As Workspace

    Set mydb = CurrentDb

    Set wrkDefault = DBEngine.Workspaces(0)

    'run the INSERT statement

    On Error GoTo Err_Execute

    wrkDefault.BeginTrans

    mydb.Execute buff, dbFailOnError

    wrkDefault.CommitTrans

    On Error GoTo 0

Success:

    Append_MySQL_To_Table = 1

    Exit Function

Err_Execute:

    Append_MySQL_To_Table = 0

    Exit Function

End Function

Private Sub CaptureData_Click()

    Dim linectr, lastElem, result, totalInserts As Long

    Dim buff As String

    Dim lineArray() As String

    Dim companyname As String

    Dim mysql_database As String

    Dim tablename As String

    companyname = [Company]

    mysql_database = [Database]

    tablename = [DBTables]

    'set up some HTML objects

    Dim objDocument As HTMLDocument

    Dim objElement As IHTMLElement

    Set objDocument = WebBrowser1.Document

    Set objElement = objDocument.body

    ' if clear table is set, verify and do it

    If [ClearFirst] = -1 Then

        result = MsgBox("Really clear " & tablename & "?", vbYesNo + vbQuestion, companyname)

        If result = vbYes Then

            result = Clear_Table(tablename)

        End If

    End If

    'get the body text

    buff = objElement.innerText

    'split into an array - each line is ended with chr(13)chr(10)

    lineArray = Split(buff, Chr(10))

    lastElem = UBound(lineArray)

    For linectr = 0 To lastElem

        'drop the trailing chr(13)

        lineArray(linectr) = Left(lineArray(linectr), Len(lineArray(linectr)) - 1)

        'std MySQL dump will have MySQL on line 0

        'and the database name on line 2

        'and table name on line 7

        'if these pass, then look for 'INSERT INTO'

        'if we find that, pass it to the SQL routine append to the table

        Dim resultTemp As String

        Select Case linectr

            Case 0

                If InStr(lineArray(linectr), "MySQL dump") = 0 Then

                    result = MsgBox("Not a MySQL dump!", vbExclamation, companyname)

                    GoTo Closer

                End If

            Case 2

                If InStr(lineArray(linectr), "Database: " & mysql_database) = 0 Then

                    result = MsgBox(resultTemp, vbExclamation, companyname)

                    GoTo Closer

                End If

            Case 7

                If InStr(lineArray(linectr), "table '" & tablename & "'") = 0 Then

                    result = MsgBox(resultTemp, vbExclamation, companyname)

                    GoTo Closer

                End If

           Case Else

                If InStr(lineArray(linectr), "INSERT INTO") > 0 Then

                    result = Append_MySQL_To_Table(tablename, lineArray(linectr))

                    If result = 1 Then

                        totalInserts = totalInserts + 1

                    End If

                End If

        End Select

    Next

    result = MsgBox("Added " & Str$(totalInserts) & " records to " & tablename & ".", vbInformation, companyname)

Closer:

End Sub

Private Sub Form_Load()

   WebBrowser1.Navigate2 "http://192.168.192.1/~stew/mysql/"

End Sub