Public Function ExecuteSQL(ByVal SQL _
As String) _
As ADODB.Recordset
'executes SQL and returns Recordset
Dim Cnn As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim sTokens() As String
On Error GoTo ExecuteSQL_Error
sTokens = Split(SQL)
Set Cnn = New ADODB.Connection
Cnn.CursorLocation = adUseClient
Cnn.Open ConnectString
If InStr("INSERT,DELETE,UPDATE", _
UCase$(sTokens(0))) Then
Cnn.Execute SQL
Msgstring = sTokens(0) & _
" query successful"
Else
Set Rst = New ADODB.Recordset
Rst.Open Trim$(SQL), Cnn, _
adOpenKeyset, _
adLockOptimistic
'rst.MoveLast 'get RecordCount
Set ExecuteSQL = Rst
Msgstring = "查询到" & Rst.RecordCount & _
" 条记录 "
End If
ExecuteSQL_Exit:
Set Rst = Nothing
Set Cnn = Nothing
Exit Function
ExecuteSQL_Error:
Msgstring = "查询错误: " & _
Err.Description
Debug.Print Msgstring
Resume ExecuteSQL_Exit
End Function
'更新数据处理,启动事务
Private Function UpdateDataToDataBase() As Boolean
UpdateDataToDataBase = False
Dim i As Integer, j As Integer
On Error GoTo errHandle:
Cnn.Errors.Clear
If Cnn.State = adStateClosed Then Cnn.Open
strSql = "update tblJoin set ProviderID=" & checkNullChar(txtInfo(0).Tag) & ",InvoiceNum='" & txtInfo(1).Text & "',BookPage='" & _
txtInfo(2).Text & "',[Memo]='" & txtInfo(3).Text & "',JoinDate=#" & dtpJoinDate & "#,StuffChargeID=" & _
checkNullChar(txtInfo(4).Tag) & ",BuyerID=" & checkNullChar(txtInfo(5).Tag) & ",BillMakerID=" & checkNullChar(txtInfo(6).Tag) & " where JoinNum='" & _
txtInfo(7).Text & "'"
Cnn.BeginTrans
Cnn.Execute strSql
If UBound(arrDeleteList) > 0 Then '测度是否有删除的记录,有就删除
For i = 1 To UBound(arrDeleteList)
strSql = "delete from tblJoinSet where [id]=" & CInt(arrDeleteList(i))
Cnn.Execute strSql
Next
End If
With flex
Dim booHaveData As Boolean '检测是否有数据
Dim booHaveID As Boolean '检测是否有ID
Dim strCurrentID As String '保存表格ID值
'检测哪行有数据.如果有数据,则判断第11列,也就是保存记录的ID列,
'看是否为0,为0就是已有数据,做更新操作,如果没有,则做插入操作
For i = 1 To .Rows - 3
booHaveData = False
booHaveID = False
For j = 1 To .Cols - 3
If .TextMatrix(i, j) <> "" Then
booHaveData = True
If .TextMatrix(j, 10) = "" Then '检测是否有ID,有ID则保存,做为更新的条件
booHaveID = False
Else
booHaveID = True
strCurrentID = .TextMatrix(j, 10)
End If
Exit For
End If
Next
If booHaveData = True Then '如果有此行有数据
If booHaveID = False Then
strSql = "insert into tblJoinSet(ProductID,Quantity,Price,NoneTax,TaxRate,Tax,[All],JoinNum) values(" & _
checkNullChar(.TextMatrix(j, 1)) & "," & checkNullChar(.TextMatrix(j, 4)) & "," & checkNullChar(.TextMatrix(j, 5)) & "," & checkNullChar(.TextMatrix(j, 6)) & "," & _
checkNullChar(.TextMatrix(j, 7)) & "," & checkNullChar(.TextMatrix(j, 8)) & "," & checkNullChar(.TextMatrix(j, 9)) & ",'" & .TextMatrix(j, 11) & "')"
Cnn.Execute strSql
Else
strSql = "update tblJoinSet set ProductID=" & checkNullChar(.TextMatrix(j, 1)) & ",Quantity=" & checkNullChar(.TextMatrix(j, 4)) & _
",Price=" & checkNullChar(.TextMatrix(j, 5)) & ",NoneTax=" & checkNullChar(.TextMatrix(j, 6)) & ",TaxRate=" & checkNullChar(.TextMatrix(j, 7)) & _
",Tax=" & checkNullChar(.TextMatrix(j, 8)) & " & ,[All]=" & checkNullChar(.TextMatrix(j, 9)) & " where [id]=" & CInt(strCurrentID)
Cnn.Execute strSql
End If
End If
Next
End With
If Cnn.Errors.Count = 0 Then
Cnn.CommitTrans
UpdateDataToDataBase = True
End If
Exit Function
errHandle:
Dim myError As ADODB.Error
If Cnn.Errors.Count > 0 Then
For Each myError In Cnn.Errors
MsgBox "更新数据发生错误:" & myError.Description, vbOKOnly, App.Title
Next
Else
MsgBox "更新数据发生未知错误!", vbOKOnly, App.Title
End If
Cnn.RollbackTrans
Exit Function
End Function
'向两个表插入数据.启用了事务处理
Private Function InsertDataToDataBase() As Boolean
InsertDataToDataBase = False
On Error GoTo errHandle:
Cnn.Errors.Clear
If Cnn.State = adStateClosed Then Cnn.Open
strSql = "insert into tblJoin(JoinNum,ProviderID,InvoiceNum,BookPage,[Memo],JoinDate,StuffChargeID,BuyerID,BillMakerID) values('" & _
txtInfo(7).Text & "'," & checkNullChar(txtInfo(0).Tag) & ",'" & txtInfo(1).Text & "','" & txtInfo(2).Text & "','" & _
txtInfo(3).Text & "',#" & dtpJoinDate.Value & "#," & checkNullChar(txtInfo(4).Tag) & "," & checkNullChar(txtInfo(5).Tag) & "," & _
checkNullChar(txtInfo(6).Tag) & ")"
Cnn.BeginTrans
Cnn.Execute strSql
Dim i As Integer
Dim j As Integer
With flex
Dim booHaveData As Boolean
For i = 1 To .Rows - 3 '检测哪行有数据.有就插,没有就跳过
booHaveData = False '每次换行,初始化为假
For j = 1 To .Cols - 3
If .TextMatrix(i, j) <> "" Then
booHaveData = True
Exit For
End If
Next
If booHaveData = True Then
strSql = "insert into tblJoinSet(ProductID,Quantity,Price,NoneTax,TaxRate,Tax,[All],JoinNum) values(" & _
checkNullChar(.TextMatrix(j, 1)) & "," & checkNullChar(.TextMatrix(j, 4)) & "," & checkNullChar(.TextMatrix(j, 5)) & "," & checkNullChar(.TextMatrix(j, 6)) & "," & _
checkNullChar(.TextMatrix(j, 7)) & "," & checkNullChar(.TextMatrix(j, 8)) & "," & checkNullChar(.TextMatrix(j, 9)) & ",'" & txtInfo(7) & "')"
Cnn.Execute strSql
End If
Next
End With
If Cnn.Errors.Count = 0 Then
Cnn.CommitTrans
InsertDataToDataBase = True
strSql = "update BillSerNum set JoinSerialNum=JoinSerialNum+1"
On Error Resume Next
Cnn.Execute strSql
If Cnn.Errors.Count > 0 Then
MsgBox "更新序号表发生错误!", vbOKOnly, App.Title
Exit Function
End If
End If
Exit Function
errHandle:
Dim myError As ADODB.Error
If Cnn.Errors.Count > 0 Then
For Each myError In Cnn.Errors
MsgBox "更新数据发生错误:" & myError.Description, vbOKOnly, App.Title
Next
Else
MsgBox "更新数据发生未知错误!", vbOKOnly, App.Title
End If
Cnn.RollbackTrans
Exit Function
End Function