Private Sub 导入_Click()
Dim i As Integer Dim dept_no As String Dim dept_name As String Set cn = CreateObject("adodb.connection") Set rs = CreateObject("ADODB.Recordset") strCn = "Provider=sqloledb;Server=INFO2;Database=ww;Uid=sa;Pwd=;" Dim strcheck As String If MsgBox("你好!是否要执行程序需要耐心等待几分钟。", 1 + 64, "执行程序") = vbOK Then cn.Open (strCn) strcheck = "select year_month from ww..wpd_prsn where year_month='" + CStr(Range("景盟!A" + LTrim(2)).Value) + "'" rs.Open strcheck, cn If Not rs.EOF Then If MsgBox("你好!此资料已导入数据库,是否需要重导?", 1 + 64, "执行程序") = vbOK Then strcheck = "delete from ww..wpd_prsn where year_month='" + CStr(Range("景盟!A" + LTrim(2)).Value) + "'" cn.Execute strcheck cn.Close i = 2 Do While Range("景盟!A" + LTrim(i)).Value <> "" If Range("景盟!V" + LTrim(i)).Value = "电脑机编织" Then dept_no = "01" dept_name = "电脑机" ElseIf Range("景盟!V" + LTrim(i)).Value = "缝合" Then dept_no = "03" dept_name = "缝合" ElseIf Range("景盟!V" + LTrim(i)).Value = "手缝" Then dept_no = "04" dept_name = "手缝" ElseIf Range("景盟!V" + LTrim(i)).Value = "整理" Then dept_no = "05" dept_name = "整理" End If cn.Open (strCn) strcheck = "insert into ww..wpd_prsn(cmp_no,year_month,fact_no,psn_name,dept_no,dept_name,jt_no,xs,grp,ylj,ON_job,upd_date)" strcheck = strcheck + " values('F003','" + CStr(Range("景盟!A" + LTrim(i)).Value) + "','" + CStr(Range("景盟!B" + LTrim(i)).Value) + "','" + CStr(Range("景盟!C" + LTrim(i)).Value) + "', " strcheck = strcheck + " '" + dept_no + "','" + dept_name + "','" + Right(Range("景盟!W" + LTrim(i)).Value + 10000, 4) + "','" + CStr(Range("景盟!X" + LTrim(i)).Value) + "','','N','Y',getdate())" cn.Execute strcheck cn.Close i = i + 1 Loop MsgBox ("资料重导成功") End If Else cn.Close cn.Open (strCn) strcheck = "update ww..wpd_prsn set on_job='N'" cn.Execute strcheck cn.Close i = 2 Do While Range("景盟!A" + LTrim(i)).Value <> "" If Range("景盟!V" + LTrim(i)).Value = "电脑机编织" Then dept_no = "01" dept_name = "电脑机" ElseIf Range("景盟!V" + LTrim(i)).Value = "缝合" Then dept_no = "03" dept_name = "缝合" ElseIf Range("景盟!V" + LTrim(i)).Value = "手缝" Then dept_no = "04" dept_name = "手缝" ElseIf Range("景盟!V" + LTrim(i)).Value = "整理" Then dept_no = "05" dept_name = "整理" End If cn.Open (strCn) strcheck = "insert into ww..wpd_prsn(cmp_no,year_month,fact_no,psn_name,dept_no,dept_name,jt_no,xs,grp,ylj,ON_job,upd_date)" strcheck = strcheck + " values('F003','" + CStr(Range("景盟!A" + LTrim(i)).Value) + "','" + CStr(Range("景盟!B" + LTrim(i)).Value) + "','" + CStr(Range("景盟!C" + LTrim(i)).Value) + "', " strcheck = strcheck + " '" + dept_no + "','" + dept_name + "','" + Right(Range("景盟!W" + LTrim(i)).Value + 10000, 4) + "','" + CStr(Range("景盟!X" + LTrim(i)).Value) + "','','N','Y',getdate())" cn.Execute strcheck cn.Close i = i + 1 Loop MsgBox ("资料导入成功") End If End If End Sub Private Sub 删除_Click() Dim strcheck As String Set cn = CreateObject("adodb.connection") Set rs = CreateObject("ADODB.Recordset") strCn = "Provider=sqloledb;Server=INFO2;Database=ww;Uid=sa;Pwd=;" If MsgBox("你好!确定要删除此资料吗?", 1 + 64, "执行程序") = vbOK Then cn.Open (strCn) strcheck = "delete from ww..wpd_prsn where year_month='" + CStr(Range("景盟!A" + LTrim(2)).Value) + "'" cn.Execute strcheck cn.Close MsgBox ("资料删除成功") End If End Sub |
|