If IsNull(Me.txtPath) = True Or Me.txtPath = "" Then
MsgBox "请选择要导入的文件！", vbExclamation
Exit Sub
End If
Dim adoConnection1 As New ADODB.Connection
Dim adoRecordset1 As New ADODB.Recordset
adoConnection1.Open "Data Provider=MSDASQL.1;driver=Microsoft Excel Driver (*.xls);DBQ=" & txtPath
adoRecordset1.Open "select * from [sheet1$]", adoConnection1, adOpenKeyset, adLockOptimistic
Dim I As Integer
For I = 1 To adoRecordset1.RecordCount - 1
'判断费用是否正确
If IsNumeric(adoRecordset1.Fields.item(4).Value) = False Then
MsgBox "要导入的费用数据不正确，请更正后再导入！！", vbExclamation
Exit Sub
End If
'判断科目是否在系统中存在
Dim cn1 As Object, rs1 As Object, sql1 As String
Set cn1 = Application.CurrentProject.Connection
Set rs1 = CreateObject("adodb.recordset")
sql1 = "select * from [tblDimCostAccount] where [CostAccountAlternateKey] =" & adoRecordset1.Fields.item(0).Value
rs1.Open sql1, cn1, 1, 1
If rs1.EOF Then
MsgBox "要导入的科目系统中不存在，请更正后再导入！", vbExclamation
Exit Sub
End If
rs1.Close
cn1.Close
'判断机台是否在系统中存在
Dim cn2 As Object, rs2 As Object, sql2 As String
Set cn2 = Application.CurrentProject.Connection
Set rs2 = CreateObject("adodb.recordset")
sql2 = "select * from [tblBaseData] where [Sort] ='" & "WorkCenterKey" & "'And [Value]='" & adoRecordset1.Fields.item(3).Value & "'"
rs2.Open sql2, cn2, 1, 1
If rs2.EOF Then
MsgBox "要导入的机台系统中不存在，请更正后再导入！", vbExclamation
Exit Sub
End If
rs2.Close
cn2.Close
adoRecordset1.MoveNext
Next I
adoRecordset1.Cancel
adoConnection1.Cancel
Dim adoConnection As New ADODB.Connection
Dim adoRecordset As New ADODB.Recordset
adoConnection.Open "Data Provider=MSDASQL.1;driver=Microsoft Excel Driver (*.xls);DBQ=" & txtPath
adoRecordset.Open "select * from [sheet1$]", adoConnection, adOpenKeyset, adLockOptimistic
Dim a As Integer
Dim cn As Object, rs As Object, sql As String
Set cn = Application.CurrentProject.Connection
Set rs = CreateObject("adodb.recordset")
sql = "select * from [tblFactWorkCenterKey]"
rs.Open sql, cn, 3, 3
If IsNull(DLookup("[ID]", "tblFactWorkCenterKey", "[CanlendarYear] ='" & Me.txtyear & "' And [CanlendarMonth]=" & Me.txtmonth & "")) = False Then
If MsgBox(Me.txtyear & "年" & Me.txtmonth & "月的数据已经导入，是否要替换？", vbYesNo + vbQuestion) = vbYes Then
DoCmd.SetWarnings 0
DoCmd.RunSQL "DELETE * FROM tblFactWorkCenterKey WHERE (((tblFactWorkCenterKey.CanlendarYear)=[Forms]![pfrmImportFactWorkCenterKey]![txtYear]) AND ((tblFactWorkCenterKey.CanlendarMonth)=[Forms]![pfrmImportFactWorkCenterKey]![txtMonth]));"
DoCmd.SetWarnings -1
For a = 1 To adoRecordset.RecordCount - 1
rs.AddNew
rs("CanlendarYear") = Me.txtyear
rs("CanlendarMonth") = Me.txtmonth
rs("CostAccountAlternateKey") = adoRecordset.Fields.item(0).Value
rs("WorkCenterKey") = adoRecordset.Fields.item(3).Value
rs("TotalCost") = adoRecordset.Fields.item(4).Value
rs.Update
adoRecordset.MoveNext
Next a
rs.Close
cn.Close
Forms![frmFactWorkCenterKey]![Child4].Requery
adoRecordset.Cancel
adoConnection.Cancel
MsgBox "数据导入成功！", vbInformation
Else
Exit Sub
End If
Else
For a = 1 To adoRecordset.RecordCount - 1
rs.AddNew
rs("CanlendarYear") = Me.txtyear
rs("CanlendarMonth") = Me.txtmonth
rs("CostAccountAlternateKey") = adoRecordset.Fields.item(0).Value
rs("WorkCenterKey") = adoRecordset.Fields.item(3).Value
rs("TotalCost") = adoRecordset.Fields.item(4).Value
rs.Update
adoRecordset.MoveNext
Next a
rs.Close
cn.Close
