如何将XMl文件的数据导入sql数据库？（十万火急需源代码，在线等待）

[slaner]

如何将XMl文件的数据导入sql数据库？

[blueheart9734]

再急也不能把问题写清楚吗,什么数据!?

[dandy1437]

很久前写的代码，希望对你有帮助
Dim rs As New ADODB.Recordset
Dim rd As New ADODB.Recordset
Dim rr As New ADODB.Recordset
Dim xmldoc As Variant
Dim rootnode As Variant
Dim priceroot As Variant '表示运价根节点
Dim pricenode As Variant '表示一条运价
Dim field As Variant '表示一个字段
Dim attr As Variant
Dim Node As Variant
Dim adate, acompany As Variant
Dim s, SS, sa, sb, sC, sm, se As String
Dim S1 As String
Dim S2 As String
Dim S3, S4, S5, S6, S7, S8, S9, S10, S11, S12, s13 As String
Dim s14, s15, s16, s17, s18, s19, s20, s21, s22, s23, s24, s25 As String
Dim s26, s27, s28, s29 As String
Dim Count As Integer
Dim i As Long
Dim CName, cfirst, tdate, edate As String
tdate = Format(G_sysdate, "yyyy-mm-dd")
With spdShowEmail
.Row = .ActiveRow
.Col = 1
CName = .Text
tname = .Text
End With
cfrist = Mid(CName, 1, 6)
If TYP = "check" Then
If cfrist = "templa" Then

Set xmldoc = CreateObject("Microsoft.XMLDOM")
On Error GoTo ErrHandler
xmldoc.async = False

Call xmldoc.Load(App.Path + "\Inemail" + "\" + CName)

If (xmldoc.parseError.errorCode) < 0 Then
MsgBox "读取数据文件发生如下错误：行号(" + CStr(xmldoc.parseError.Line) + "), 列号(" + CStr(xmldoc.parseError.linepos) + ")" + vbCrLf + _
"错误原因: " + xmldoc.parseError.reason + vbCrLf + _
"错误文本: " + xmldoc.parseError.srcText
Exit Sub
End If

Set rootnode = xmldoc.documentElement '取得根节点
If rootnode Is Nothing Then
MsgBox "数据文件为空！"
GoTo ClearAndExit
End If
'验证根节点的名称为freight-data
If rootnode.baseName <> "freight-data" Then
MsgBox "数据内容错误"
GoTo ClearAndExit
End If

'检查必要的属性
If rootnode.Attributes Is Nothing Then
MsgBox "根节点缺少必要的属性"
GoTo ClearAndExit
End If

Set attr = rootnode.Attributes.getNamedItem("version")
If attr Is Nothing Then
MsgBox "未找到版本数据"
GoTo ClearAndExit
End If
s = attr.Text
If s <> "1.0" Then
MsgBox "当前仅支持1.0版本的数据"
GoTo ClearAndExit
End If

Set attr = rootnode.Attributes.getNamedItem("gen-date")
' Set adate = attr
If attr Is Nothing Then
MsgBox "未找到生成时间"
GoTo ClearAndExit
End If

s = attr.Text

Set attr = rootnode.Attributes.getNamedItem("gen-email")

If attr Is Nothing Then
MsgBox "未找到email"
GoTo ClearAndExit
End If

sm = attr.Text

Set attr = rootnode.Attributes.getNamedItem("gen-Cname")

If attr Is Nothing Then
MsgBox "未找到单位中文名称"
GoTo ClearAndExit
End If

sa = attr.Text

Set attr = rootnode.Attributes.getNamedItem("gen-address")

If attr Is Nothing Then
MsgBox "未找到单位地址"
GoTo ClearAndExit
End If

sb = attr.Text

Set attr = rootnode.Attributes.getNamedItem("gen-phone")

If attr Is Nothing Then
MsgBox "未找到单位电话"
GoTo ClearAndExit
End If

sC = attr.Text

Set attr = rootnode.Attributes.getNamedItem("gen-fax")

If attr Is Nothing Then
MsgBox "未找到单位传真"
GoTo ClearAndExit
End If

se = attr.Text

Set attr = rootnode.Attributes.getNamedItem("gen-unit")

If attr Is Nothing Then
MsgBox "未找到生成单位简称"
GoTo ClearAndExit
End If

SS = attr.Text

Set attr = rootnode.Attributes.getNamedItem("gen-username")

If attr Is Nothing Then
MsgBox "未找到生成报价SALES"
GoTo ClearAndExit
End If

sf = attr.Text

Set attr = rootnode.Attributes.getNamedItem("gen-useremail")

If attr Is Nothing Then
MsgBox "未找到生成报价SALES信箱地址"
GoTo ClearAndExit
End If

sg = attr.Text

'取价格
If Not rootnode.hasChildNodes Then
MsgBox "没有数据"
GoTo ClearAndExit
Else
For Each Node In rootnode.childNodes
If Node.baseName = "price" Then
Set priceroot = Node
Exit For
End If
Next
End If

If priceroot Is Nothing Then
MsgBox "没有价格数据"
GoTo ClearAndExit
End If

Count = 0
For Each pricenode In priceroot.childNodes
If pricenode.baseName <> "record" Then
MsgBox "价格数据错误"
GoTo ClearAndExit
Else '一条价格记录
S1 = ""
S2 = ""
For Each Node In pricenode.childNodes
If Node.baseName = "ID" Then
S1 = Node.Text
ElseIf Node.baseName = "生效日期" Then
S2 = Node.Text
edate = Format(S2, "yyyy-mm-dd")
ElseIf Node.baseName = "失效日期" Then
S3 = Node.Text
ElseIf Node.baseName = "承运人" Then
S4 = Node.Text
ElseIf Node.baseName = "开船日期" Then
S5 = Node.Text
' TTin = s5
' Call EtdChangeIn
ElseIf Node.baseName = "目的港" Then
S6 = Node.Text
ElseIf Node.baseName = "起运港" Then
s14 = Node.Text
ElseIf Node.baseName = "GP20价格" Then
S7 = Node.Text
ElseIf Node.baseName = "GP40价格" Then
S8 = Node.Text
ElseIf Node.baseName = "GP45价格" Then
S9 = Node.Text
ElseIf Node.baseName = "中转港" Then
S10 = Node.Text
ElseIf Node.baseName = "航程" Then
S11 = Node.Text
ElseIf Node.baseName = "报价协议号" Then
S12 = Node.Text
ElseIf Node.baseName = "备注" Then
s13 = Node.Text
Else
MsgBox "价格记录字段错误"
GoTo ClearAndExit
End If
Next
Count = Count + 1
rs.Open "select * from freight_in_price where booking_co=('" & SS & "') and etd=('" & S5 & "') and sp_price='0 'and carrier=('" & S4 & "')and end_date> ('" & tdate & "') and ('" & edate & "')>('" & tdate & "') and port_loading=('" & s14 & "') and port_discharge=('" & S6 & "') and status=0 ", ADO_Cnn, adOpenKeyset, adLockOptimistic
If Not rs.EOF Then
rs.Fields("end_date") = Format(S2, "yyyy-mm-dd")
rs.Fields("status") = -1
rs.UPdate


End If
rs.Close

rs.Open "select * from freight_in_price where booking_co=('" & SS & "') and etd=('" & S5 & "') and sp_price='0 'and carrier=('" & S4 & "')and end_date> ('" & tdate & "') and ('" & edate & "')<=('" & tdate & "') and port_loading=('" & s14 & "') and port_discharge=('" & S6 & "') and status=0 ", ADO_Cnn, adOpenKeyset, adLockOptimistic
If Not rs.EOF Then
rs.Fields("status") = -1
rs.UPdate


End If
rs.Close

[dandy1437]

接在上面程序的后面
rs.Open "select * from freight_in_price where booking_co=('" & SS & "') and etd=('" & S5 & "') and sp_price='0' and carrier=('" & S4 & "')and end_date> ('" & tdate & "') and ('" & edate & "')>=('" & tdate & "') and port_loading=('" & s14 & "') and port_discharge=('" & S6 & "') and status=0 ", ADO_Cnn, adOpenKeyset, adLockOptimistic
If Not rs.EOF Then
rs.Fields("status") = -1
rs.UPdate

End If
rs.Close

rs.Open "select * from freight_in_price where booking_co=('" & SS & "') and etd=('" & S5 & "') and sp_price='0' and carrier=('" & S4 & "')and end_date< ('" & tdate & "') and ('" & edate & "')>('" & tdate & "') and port_loading=('" & s14 & "') and port_discharge=('" & S6 & "') and status=0 ", ADO_Cnn, adOpenKeyset, adLockOptimistic
If Not rs.EOF Then
rs.Fields("status") = -1
rs.UPdate

End If
rs.Close

rs.Open "select * from freight_in_price where booking_co=('" & SS & "') and etd=('" & S5 & "') and sp_price='0' and carrier=('" & S4 & "')and end_date< ('" & edate & "') and ('" & edate & "')<('" & tdate & "') and port_loading=('" & s14 & "') and port_discharge=('" & S6 & "') and status=0 ", ADO_Cnn, adOpenKeyset, adLockOptimistic
If Not rs.EOF Then
rs.Fields("status") = -1
rs.UPdate

End If
rs.Close

rs.Open "select * from freight_in_price where 1=0", ADO_Cnn, adOpenKeyset, adLockOptimistic
rs.AddNew
rs.Fields("booking_co") = SS
rs.Fields("interior_code") = S1
rs.Fields("carrier") = S4
rs.Fields("port_discharge") = S6
rs.Fields("in_date") = Format(s, "yyyy-mm-dd")
rs.Fields("container_type") = "GP"
rs.Fields("price_20") = S7
rs.Fields("price_40") = S8
rs.Fields("price_45") = S9
rs.Fields("commission") = "4.25%"
rs.Fields("etd") = S5
rs.Fields("sail_day") = S11
rs.Fields("vis") = S10
rs.Fields("notes") = s13
rs.Fields("begin_date") = Format(S2, "yyyy-mm-dd")
rs.Fields("end_date") = Format(S3, "yyyy-mm-dd")
rs.Fields("status") = 0
rs.Fields("cargo_type") = "普通货物"
rs.Fields("transit_type") = "集装箱"
rs.Fields("sales") = g_sUserID
rs.Fields("freight_type") = "FREIGHT PREPAID"
rs.Fields("contract_no_sales") = S12
rs.Fields("sp_price") = 0
rs.Fields("port_loading") = s14
rs.UPdate
rs.Close

End If
Next
rd.Open "select * from company_data where code=('" & SS & "')", ADO_Cnn, adOpenKeyset, adLockOptimistic
If rd.EOF Then
rd.AddNew
rd.Fields("code") = SS
rd.Fields("name") = sa
rd.Fields("address") = sb
rd.Fields("phone") = sC
rd.Fields("fax") = se
rd.Fields("email") = sm
rd.Fields("class") = "Z"
rd.UPdate
rd.Close
Else
rd.Fields("email") = sm
rd.Fields("name") = sa
rd.Fields("address") = sb
rd.Fields("phone") = sC
rd.Fields("fax") = se
rd.UPdate
rd.Close
End If
Dim iuy As New ADODB.Recordset
iuy.Open "delete from company_employee_data where email=('" & sg & "')", ADO_Cnn, adOpenKeyset, adLockOptimistic
rr.Open "select * from company_employee_data where name=('" & sf & "') and email=('" & sg & "') and company_code=('" & sa & "')", ADO_Cnn, adOpenKeyset, adLockOptimistic
If rr.EOF Then
rr.AddNew
rr.Fields("name") = sf
rr.Fields("email") = sg
rr.Fields("company_code") = SS
rr.UPdate
rr.Close
End If
MsgShow "数据传送成功"

With spdShowEmail
.Row = .ActiveRow
.Col = -1
.BackColor = &HFFFFFF
.ForeColor = &HFF&
.Col = 7
.Text = 1
.Col = 8
If .Text = "check" Then
Kill (App.Path + "\Inemail" + "\" + CName)
End If
End With
With ToolbarShowEmail
.Buttons("InData").Enabled = False
' .Buttons("delete").Enabled = False
End With
End If

[since1990]

帮你 up

[yipingyuan]

非常感谢大家的关心，但程序太长了。我是新手，还要慢慢调试，向大家学习！