This code will take each email and parses out 3 fields and loads the values
into mysql database (shared host)
My parse works fine but I'm not getting a connection.
Anyone see anything?
Is there a way to log database connection errors

Thanks
Steve


Sub gettext()
Dim str As String, i As Long
Dim strOrderNumber As String, strOrderDate As String
Dim strShipToName As String, strShipToAddress As String
Dim strEbayID As String
Dim whereclause As String



'Dim strShipToAddress1 As String, strShipToAddress2 As String
Set MyExplorer = Application.ActiveExplorer
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cnn = New ADODB.Connection

' Set properties of the Connection.
cnn.ConnectionString = "DSN=mailthem mysql;UID=uname;PWD=pass;"
cnn.ConnectionTimeout = 30

' Find out if the attempt to connect worked.
If cnn.State = adStateOpen Then
MsgBox "Welcome to the Demo Database!"
Else
MsgBox "Sorry. No Database Access."
End If


' Open the connection.
cnn.Open
For i = 1 To MyExplorer.CurrentFolder.Items.Count
Set MyItem = MyExplorer.CurrentFolder.Items(i)
str = MyItem.Body


On Error Resume Next
i = InStr(1, str, "Order Number: ") + Len("Order Number: ")
strOrderNumber = Mid(str, i, InStr(i, str, vbCr) - i)

i = InStr(1, str, "Order Date: ") + Len("Order Date: ")
strOrderDate = Mid(str, i, InStr(i, str, vbCr) - i)

' i = InStr(1, str, " ") + Len(" ")
' strEbayID = Mid(str, i, InStr(i, str, vbCr) - i)


'i = InStr(1, str, "Ship To:")
'i = InStr(i, str, " ")
'strShipToName = Trim(Mid(str, i, InStr(i, str, vbCr) - i))
'i = InStr(i, str, vbCr)
'i = InStr(i, str, " ")


'strShipToAddress = Trim(Mid(str, i, InStr(i, str, vbCr) - i))
'i = InStr(i, str, vbCr)
'i = InStr(i, str, " ")
'strShipToAddress = strShipToAddress & vbNewLine & Trim(Mid(str, i,
InStr(i, str, vbCr) - i))
'i = InStr(i, str, vbCr)
'i = InStr(i, str, " ")
'strShipToAddress = strShipToAddress & vbNewLine & Trim(Mid(str, i,
InStr(i, str, vbCr) - i))

whereclause = " where " + ordernum + " NOT IN (Select ordernum from
hom_orders);"
MsgBox strOrderNumber
MsgBox strOrderDate
'MsgBox strShipToName
'MsgBox strShipToAddress
MsgBox strEbayID
query = "Insert into hom_orders (ordernum, orderdate, ebayid) VALUES ("
+ strOrderNumber + "," + _
strOrderDate + "," + strEbayID + ")" + whereclause


'query = "Select * From T_LastTouched Where txt_TicketNumber = '" +
coldigits + "'"
Set rs = cnn.Execute(query)
MsgBox query


'Set rs = Nothing

' Close the connection.

Next i
Set rs = Nothing
cnn.Close
End Sub