【VB开源代码栏目提醒】:网学会员,鉴于大家对VB开源代码十分关注,论文会员在此为大家搜集整理了“frmdataimport.frm”一文,供大家参考学习!
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmdataimport
BorderStyle = 3 'Fixed Dialog
Caption = "学生基本数据导入"
ClientHeight = 4290
ClientLeft = 45
ClientTop = 330
ClientWidth = 4545
Icon = "frmdataimport.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4290
ScaleWidth = 4545
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.Frame Frame1
Height = 3885
Left = 210
TabIndex = 0
Top = 150
Width = 4065
Begin VB.TextBox Text1
BackColor = &H80000018&
Height = 330
Left = 270
TabIndex = 5
Top = 570
Width = 3105
End
Begin VB.CommandButton Command1
Caption = "..."
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 3360
TabIndex = 4
Top = 570
Width = 495
End
Begin VB.ListBox List1
BackColor = &H80000018&
Height = 1140
Left = 270
TabIndex = 3
Top = 1515
Width = 3135
End
Begin VB.CommandButton Command2
Caption = "确定(&O)"
Default = -1 'True
Height = 420
Left = 1590
TabIndex = 2
Top = 3240
Width = 915
End
Begin
VB.CommandButton Command3
Cancel = -1 'True
Caption = "取消(&C)"
Height = 420
Left = 2670
TabIndex = 1
Top = 3240
Width = 915
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 1935
Top = 990
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1.请选择数据库"
BeginProperty Font
Name = "楷体_GB2312"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 270
TabIndex = 7
Top = 210
Width = 1605
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "2.请选择表"
BeginProperty Font
Name = "楷体_GB2312"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 1
Left = 270
TabIndex = 6
Top = 1200
Width = 1155
End
End
End
Attribute VB_Name = "frmdataimport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As New ADODB.Recordset
Dim comm As New ADODB.Command
Dim table_name As String
Dim rsfield As ADODB.Field
Private Sub Command1_Click()
CommonDialog1.CancelError = False
CommonDialog1.Filter = "ACCESS(*.mdb)|*.mdb"
CommonDialog1.DialogTitle = "open database"
CommonDialog1.ShowOpen
If CommonDialog1.filename = "" Then
Exit Sub
Else '获取数据库中所有表的名称
opendatabase CommonDialog1.filename
Text1.Text = CommonDialog1.filename
' List1.Clear
Set rs = cntemp.OpenSchema(adSchemaTables)
Do Until rs.EOF
If rs!table_type = "TABLE" Then
List1.AddItem rs!table_name
End If
rs.MoveNext
Loop
End If
End Sub
Private Sub Command2_Click()
'*************************这里是数据导入的
程序**************************
On Error GoTo err
t = MsgBox("是否将该表导入人员基本信息表!", vbOKCancel + vbExclamation, "注意")
If t = 1 Then
Set rs = New ADODB.Recordset
table_name = List1.Text
strsql = "select * from " & table_name
rs.open str
sql, cntemp, adOpenStatic, adLockPessimistic
Call condatabase
Set rsrmk = New ADODB.Recordset
rsrmk.open "select * from rmk", cn, adOpenStatic, adLockPessi
mistic
'**********把要导入的数据付值给RMK表**********
Dim msg As String
If rs.recordcount <> 0 Then
For i = 0 To rs.recordcount - 1
rsrmk.AddNew
For j = 0 To 5
rsrmk.Fields(j).Value = rs.Fields(j).Value
Next j
rsrmk.Update
rs.MoveNext
Next i
msg = "成功完成数据导入!共有" & rs.recordcount & "记录被导入人员基本信息表!"
MsgBox msg, vbOKOnly, "完成"
Else
MsgBox "要导入的数据表中无记录!", vbOKOnly + vbExclamation, "注意"
End If
'********************************************
Else
Exit Sub
End If
Exit Sub
err:
MsgBox err.Description, vbOKOnly + vbExclamation, "出错了"
'********************************************************************
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Function opendatabase(filename As String)
Set cntemp = New ADODB.Connection
Set rs = Nothing
Set comm = Nothing
Set rsfield = Nothing
cntemp.Provider = "Microsoft.Jet.OLEDB.4.0"
On Error GoTo disposal
cntemp.open filename
Exit Function
disposal:
Dim err As ADODB.Error
Dim errstr As String
If cntemp = "" Then
MsgBox "没有连接数据库文件!"
Else
For Each err In conn.Errors
errstr = errstr & "错误描述:" & err.Description & vbCr
Next
MsgBox errstr, vbOKOnly, "注意"
E