Option Explicit
上传数据
Private Sub CommandButton1_Click()
If MsgBox("请确认数据是否准确,是否确认上传?", vbCritical + 6 + 16, "温馨提示") = vbNo Then
Exit Sub
End If
'保存数据
Dim r, Atnum, rscount, i As Integer
r = 6
Atnum = Sheet1.UsedRange.Rows.Count
If Atnum < 6 Then
MsgBox "无数据可上传!"
Exit Sub
End If
Call OpenCn
Dim sql As String
sql = "insert into demo_based(bemployee) values(1194)"
cn.Execute sql
Call CloseCn
If Err.Number <> 0 Then
MsgBox Err.Description
Else
MsgBox "数据上传成功,共上传了" + CStr(Atnum - 5) + "条数据"
End If
End Sub
核查数据,while循环
Private Sub CommandButton3_Click()
Dim sql, bl, tl As String, rsnum As Integer, DNum, i, sum, r As Integer
DNum = Sheet1.UsedRange.EntireRow.Count
Call OpenCn
i = 6
While (Len(Sheet1.Cells(i, 1)) > 0)
MsgBox i
bl = Sheet1.Range("A" & i)
sql = "select id,bgroup,company,department_id from hr_employee where job_no='" + bl + "'"
rs.CursorLocation = adUseClient
rs.Open sql, cn, 1, 1
With Sheet1
.Range("T" & i).CopyFromRecordset rs '添加数据到excel表中
rsnum = .UsedRange.EntireRow.Count
' .Range("T" + CStr(rsnum)).Borders.LineStyle = 1 '给单元格加边框
End With
rs.Close
i = i + 1
sum = i - 6
Wend
MsgBox "完成" + CStr(sum) + "核查"
Call CloseCn
End Sub
这是for循环,核查数据
Private Sub CommandButton3_Click()
Dim sql, bl, tl As String, rsnum As Integer, DNum, i, r As Integer
DNum = Sheet1.UsedRange.EntireRow.Count
Call OpenCn
For i = 6 To DNum
bl = Sheet1.Range("A" & i)
sql = "select id,bgroup,company,department_id from hr_employee where job_no='" + bl + "'"
rs.CursorLocation = adUseClient
rs.Open sql, cn, 1, 1
With Sheet1
.Range("T" & i).CopyFromRecordset rs '添加数据到excel表中
rsnum = .UsedRange.EntireRow.Count
' .Range("T" + CStr(rsnum)).Borders.LineStyle = 1 '给单元格加边框
End With
rs.Close
Next
MsgBox "完成" + CStr(DNum - 5) + "核查"
Call CloseCn
End Sub
心有猛虎,细嗅蔷薇