📄 datainfrm.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form datainfrm
BackColor = &H00FF8080&
BorderStyle = 0 'None
Caption = "数据导入"
ClientHeight = 2505
ClientLeft = 0
ClientTop = 0
ClientWidth = 5610
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 2505
ScaleWidth = 5610
ShowInTaskbar = 0 'False
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4800
Top = 1200
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame Frame1
BackColor = &H00FF8080&
Caption = "数据导入"
Height = 2055
Left = 0
TabIndex = 0
Top = 240
Width = 5535
Begin VB.CommandButton Command5
BackColor = &H00FF8080&
Caption = "覆盖导入"
Height = 495
Left = 1560
TabIndex = 6
Top = 1320
Width = 855
End
Begin VB.CommandButton Command4
BackColor = &H00FF8080&
Caption = "浏览文件"
Height = 495
Left = 4320
TabIndex = 5
Top = 360
Width = 1095
End
Begin VB.CommandButton Command3
BackColor = &H00FF8080&
Caption = "退出"
Height = 495
Left = 4440
TabIndex = 4
Top = 1320
Width = 855
End
Begin VB.CommandButton Command2
BackColor = &H00FF8080&
Caption = "清空导入"
Height = 495
Left = 3000
TabIndex = 3
Top = 1320
Width = 855
End
Begin VB.CommandButton Command1
BackColor = &H00FF8080&
Caption = "追加导入"
Height = 495
Left = 120
TabIndex = 2
Top = 1320
Width = 855
End
Begin VB.TextBox Text1
Height = 495
Left = 120
TabIndex = 1
Top = 360
Width = 4215
End
End
End
Attribute VB_Name = "datainfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
'追加导入时候，判断是否已经存在记录的时候
'这条记录通过①村和序号②区和序号 来判断是否存在
'list.listindex的值以6为分界
Select Case dhfrm.List1.ListIndex
Case Is < 6
If Text1.Text = "" Then
MsgBox "请选择*.xls数据", vbOKOnly, "数据导入操作"
Exit Sub
Else
'mdbname = dhfrm.List1.list(dhfrm.List1.ListIndex)
Dim rdst3 As New ADODB.Recordset
rdst3.Open "select * from tablename where fid = " & dhfrm.List1.ListIndex + 1 & "", g_conn
mdbname = rdst3!表名
mdbcols = rdst3!列数
'CommonDialog1.Flags = cdlOFNAllowMultiselect 单选多选
'连接*.xls文件
datain_conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & xlsname & ""
'打开*.xls文件
Dim rdst As New ADODB.Recordset
rdst.Open "select * from [a$]", datain_conn
'循环xls数据表,进行逐行添加
Do While Not rdst.EOF
Dim ardst As New ADODB.Recordset
ardst.Open "select * from " & mdbname & " where 村='" & rdst.Fields(3).Value & "'and 序号='" & rdst.Fields(4).Value & "'", g_conn
If ardst.EOF = True Then
Dim i As Integer
Dim xlsvalue As String
xlsvalue = ""
For i = 1 To mdbcols
If IsNull(rdst.Fields(i - 1).Value) = True Then
xlsvalue = xlsvalue & "'0'" & ","
Else
xlsvalue = xlsvalue & "'" & rdst.Fields(i - 1).Value & "'" & ","
End If
Next i
xlsvalue = Left(xlsvalue, Len(xlsvalue) - 1)
Debug.Print xlsvalue
'打开mdb进行追加
Dim rdst2 As New ADODB.Recordset
rdst2.Open "insert into " & mdbname & " values(" & xlsvalue & ")", g_conn
Else
Dim ts As String
ts = MsgBox("导入相同记录,确定覆盖,取消跳过", vbOKCancel, "记录重复")
If ts = vbOK Then
Dim dr As New ADODB.Recordset
dr.Open "delete * from " & mdbname & " where 村='" & rdst.Fields(3).Value & "'and 序号='" & rdst.Fields(4).Value & "'", g_conn
Set dr = Nothing
xlsvalue = ""
For i = 1 To mdbcols
If IsNull(rdst.Fields(i - 1).Value) = True Then
xlsvalue = xlsvalue & "'0'" & ","
Else
xlsvalue = xlsvalue & "'" & rdst.Fields(i - 1).Value & "'" & ","
End If
Next i
xlsvalue = Left(xlsvalue, Len(xlsvalue) - 1)
'打开mdb进行追加
rdst2.Open "insert into " & mdbname & " values(" & xlsvalue & ")", g_conn
Else
MsgBox "跳过" & rdst.Fields(4).Value & rdst.Fields(3).Value, vbOKOnly, "跳过记录"
End If
End If
Set ardst = Nothing
rdst.MoveNext
Loop
killmore (mdbname)
Set rdst = Nothing
Set rdst2 = Nothing
Set rdst3 = Nothing
xlsname = ""
mdbname = ""
mdbcols = 0
Text1.Text = ""
datain_conn.Close
MsgBox "导入完成", vbOKOnly, "数据导入完成"
Exit Sub
End If
Case Is = 6
' On Error GoTo err1:
If Text1.Text = "" Then
MsgBox "请选择*.xls数据", vbOKOnly, "数据导入操作"
Exit Sub
Else
'mdbname = dhfrm.List1.list(dhfrm.List1.ListIndex)
'Dim rdst3 As New ADODB.Recordset
rdst3.Open "select * from tablename where fid = " & dhfrm.List1.ListIndex + 1 & "", g_conn
mdbname = rdst3!表名
mdbcols = rdst3!列数
'CommonDialog1.Flags = cdlOFNAllowMultiselect 单选多选
'连接*.xls文件
datain_conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & xlsname & ""
'打开*.xls文件
' Dim rdst As New ADODB.Recordset
rdst.Open "select * from [a$]", datain_conn
'循环xls数据表,进行逐行添加
Do While Not rdst.EOF
' Dim ardst As New ADODB.Recordset
ardst.Open "select * from " & mdbname & " where 区='" & rdst.Fields(1).Value & "'and 序号='" & rdst.Fields(3).Value & "'", g_conn
If ardst.EOF = True Then
'Dim i As Integer
' Dim xlsvalue As String
xlsvalue = ""
For i = 1 To mdbcols
If IsNull(rdst.Fields(i - 1).Value) = True Then
xlsvalue = xlsvalue & "'0'" & ","
Else
xlsvalue = xlsvalue & "'" & rdst.Fields(i - 1).Value & "'" & ","
End If
Next i
xlsvalue = Left(xlsvalue, Len(xlsvalue) - 1)
Debug.Print xlsvalue
'打开mdb进行追加
' Dim rdst2 As New ADODB.Recordset
rdst2.Open "insert into " & mdbname & " values(" & xlsvalue & ")", g_conn
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -