Domino 7 使用 ADO 做 Mysql 的 新增,修改,刪除及查詢

查詢

Sub Initialize
On Error Goto ErrHandle
Set session=New NotesSession
Set db=session.CurrentDatabase
Set ws=New NotesUIWorkspace
Set agent = session.CurrentAgent
Set currentLog = New NotesLog( db.Title+" - Agent - "+agent.Name+" on "+db.Server )
Set profile=db.GetProfileDocument("SystemProfile")
Call currentLog.OpenNotesLog( db.Server, profile.LogPath(0) )
Dim conn As Variant
Set conn = CreateObject ("ADODB.Connection")
ConnAdmin = "DRIVER={MySQL ODBC 5.1 Driver}; SERVER="+profile.SqlServer(0)+"; DATABASE="+profile.SqlDatabase(0)+";UID="+profile.SqlAccount(0)+";PASSWORD="+profile.SqlPasswd(0)+"; OPTION=3"
conn.open ConnAdmin
Set uidoc=ws.CurrentDocument
Set doc=uidoc.Document
Set RSTT = CreateObject("ADODB.Recordset")
'SQL = "SELECT * FROM mm_budget WHERE MM_MARA_MATNR='"+doc.ItemNo(0)+"'"
SQL = "SELECT * FROM mm_budget WHERE MM_MARA_MATNR='"+uidoc.FieldGetText("ItemNo")+"' AND BGTDATE>'" +uidoc.FieldGetText("Result")+"'"
rstt.CursorLocation=3
rstt.open SQL, conn, 1,3
rstt.Sort = "BGTDATE DESC"
Call uidoc.FieldClear("A")
Call uidoc.FieldClear("B")
Call uidoc.FieldClear("C")
Call uidoc.FieldClear("D")
Call uidoc.FieldClear("E")
Call uidoc.FieldClear("F")
Do While Not rstt.eof
' For i = 0 To 5
' this.field=rstt.Fields(i).field
' this.value=rstt.Fields(i).value
' Set item = doc.AppendItemValue (field, value)
' Next
Call uidoc.FieldAppendText("A",Cstr(rstt.Fields(0).value)+Chr(10)+Chr(13))
Call uidoc.FieldAppendText("B",Cstr(rstt.Fields(4).value)+Chr(10)+Chr(13))
Call uidoc.FieldAppendText("C",Cstr(rstt.Fields(2).value)+Chr(10)+Chr(13))
Call uidoc.FieldAppendText("D",Cstr(rstt.Fields(5).value)+Chr(10)+Chr(13))
Call uidoc.FieldAppendText("E",Cstr(rstt.Fields(3).value)+Chr(10)+Chr(13))
Call uidoc.FieldAppendText("F",Cstr(rstt.Fields(1).value)+Chr(10)+Chr(13))
RSTT.MoveNext
Loop
rstt.close
conn.close
ErrHandle:
Print  "Error" & Str(Err) & ": " & Error$ & " on line " & Cstr(Erl)
Call currentLog.LogError(0,"不明錯誤，請查詢Log 記錄 : " & "Error" & Str(Err) & ": " & Error$ & " on line " & Cstr(Erl))
End Sub

新增

Sub Initialize
On Error Goto ErrHandle
Set session=New NotesSession
Set db=session.CurrentDatabase
Set ws=New NotesUIWorkspace
Set agent = session.CurrentAgent
Set currentLog = New NotesLog( db.Title+" - Agent - "+agent.Name+" on "+db.Server )
Set profile=db.GetProfileDocument("SystemProfile")
Call currentLog.OpenNotesLog( db.Server, profile.LogPath(0) )
Dim avarNew As Variant
avarNew = Split(profile.RecNo(0), "|")
Dim conn As Variant
Set conn = CreateObject ("ADODB.Connection")
ConnAdmin = "DRIVER={MySQL ODBC 5.1 Driver}; SERVER="+profile.SqlServer(0)+"; DATABASE="+profile.SqlDatabase(0)+";UID="+profile.SqlAccount(0)+";PASSWORD="+profile.SqlPasswd(0)+"; OPTION=3"
conn.open ConnAdmin
Set uidoc=ws.CurrentDocument
Set doc=uidoc.Document
SQL = "INSERT INTO `mis`.`mm_budget` (`BGTTYPE`, `BGTDATE`, `QTY`, `MM_MARA_MATNR`, `MM_KOS_KOSTL`) VALUES ('"+avarNew(4)+"', '"+avarNew(1)+"', '"+avarNew(3)+"', '"+avarNew(0)+"', '"+avarNew(2)+"')"
Call currentlog.LogAction(SQL)
conn.execute(SQL)
conn.close
ErrHandle:
Print  "Error" & Str(Err) & ": " & Error$ & " on line " & Cstr(Erl)
Call currentLog.LogError(0,"不明錯誤，請查詢Log 記錄 : " & "Error" & Str(Err) & ": " & Error$ & " on line " & Cstr(Erl))
End Sub

刪除

Sub Initialize
On Error Goto ErrHandle
Set session=New NotesSession
Set db=session.CurrentDatabase
Set ws=New NotesUIWorkspace
Set agent = session.CurrentAgent
Set currentLog = New NotesLog( db.Title+" - Agent - "+agent.Name+" on "+db.Server )
Set profile=db.GetProfileDocument("SystemProfile")
Call currentLog.OpenNotesLog( db.Server, profile.LogPath(0) )
Dim conn As Variant
Set conn = CreateObject ("ADODB.Connection")
ConnAdmin = "DRIVER={MySQL ODBC 5.1 Driver}; SERVER="+profile.SqlServer(0)+"; DATABASE="+profile.SqlDatabase(0)+";UID="+profile.SqlAccount(0)+";PASSWORD="+profile.SqlPasswd(0)+"; OPTION=3"
conn.open ConnAdmin
Set uidoc=ws.CurrentDocument
Set doc=uidoc.Document
SQL = "DELETE FROM `mis`.`mm_budget` WHERE `BGTID`='"+profile.RecNo(0)+"';"
Call currentlog.LogAction(SQL)
conn.execute(SQL)
conn.close
ErrHandle:
Print  "Error" & Str(Err) & ": " & Error$ & " on line " & Cstr(Erl)
Call currentLog.LogError(0,"不明錯誤，請查詢Log 記錄 : " & "Error" & Str(Err) & ": " & Error$ & " on line " & Cstr(Erl))
End Sub

修改

Sub Initialize
On Error Goto ErrHandle
Set session=New NotesSession
Set db=session.CurrentDatabase
Set ws=New NotesUIWorkspace
Set agent = session.CurrentAgent
Set currentLog = New NotesLog( db.Title+" - Agent - "+agent.Name+" on "+db.Server )
Set profile=db.GetProfileDocument("SystemProfile")
Call currentLog.OpenNotesLog( db.Server, profile.LogPath(0) )
Dim avarNew As Variant
avarNew = Split(profile.RecNo(0), "|")
Dim conn As Variant
Set conn = CreateObject ("ADODB.Connection")
ConnAdmin = "DRIVER={MySQL ODBC 5.1 Driver}; SERVER="+profile.SqlServer(0)+"; DATABASE="+profile.SqlDatabase(0)+";UID="+profile.SqlAccount(0)+";PASSWORD="+profile.SqlPasswd(0)+"; OPTION=3"
conn.open ConnAdmin
Set uidoc=ws.CurrentDocument
Set doc=uidoc.Document
SQL = "UPDATE `mis`.`mm_budget` SET `MM_MARA_MATNR`='"+DoTrim(avarNew(1))+"',`MM_KOS_KOSTL`='"+DoTrim(avarNew(3))+"',`BGTTYPE`='"+DoTrim(avarNew(5))+"',`BGTDATE`='"+DoTrim(avarNew(2))+"', `QTY`='"+DoTrim(avarNew(4))+"' WHERE `BGTID`='"+DoTrim(avarNew(0))+"';"
Call currentlog.LogAction(SQL)
conn.execute(SQL)
conn.close
ErrHandle:
Print  "Error" & Str(Err) & ": " & Error$ & " on line " & Cstr(Erl)
Call currentLog.LogError(0,"不明錯誤，請查詢Log 記錄 : " & "Error" & Str(Err) & ": " & Error$ & " on line " & Cstr(Erl))
End Sub