'Public fn As String '保存Access文件名
'Public fn1 As String '保存Excel文件名
'Public fncount As Integer '保存Access數據庫表的字段教
'Public fn1count As Integer '保存ExceI數據庫表的字段數
Dim excel_aq As New ADODB.Recordset
Dim sandan_aq As New ADODB.Recordset

’ 聲明一個EXCEL數據庫的連接
Dim sql, m

Private Sub Check1_Click(Index As Integer)
X = Index
If Check1(X).Value = 1 Then List2.AddItem Check1(X).Caption
If Check1(X).Value = 0 Then
For i = 0 To List2.ListCount
If List2.List(i) = Check1(X).Caption Then List2.RemoveItem (i)
Next i

For i = 0 To List1.ListCount
If List2.List(i) = Check1(X).Caption Then Check1(X).Value = 1

Next i

End If
End Sub

Private Sub Check3_Click()
For i = 0 To 18
If Check3.Value = 1 Then
Check1(i).Value = 1
Else
End If
Next i

End Sub

Private Sub Cmdout_Click()
Dim a11 As String
'For K = 0 To DataGrid1.ApproxCount - 1

Do While Not excel_aq.EOF
a11 = excel_aq(“身份證號”)

sql = “select * from 學戶冊 where 身份證號= '” & a11 & “’”
sql = “select * from 學戶冊”
If sandan_aq.State = adStateOpen Then rds_book.Close
sandan_aq.Open sql, myconn, adOpenDynamic, adLockOptimistic

On Error GoTo Err_Handler:
If Not excel_aq.EOF Then
For i = 0 To List2.ListCount - 1
sandan_aq(List2.List(i)) = excel_aq(List2.List(i))
Next i
sandan_aq.Update
Set sandan_aq = Nothing
End If
’ Label2.Caption = RS.RecordCount & “名人的信息導入! 進度為：” & CStr(CInt(Progress2.Value / RS.RecordCount * 100)) & “%”
excel_aq.MoveNext
DoEvents
Loop
MsgBox " 導入成功！", 48, “提示”
Err_Handler:
If err = 0 Then
Screen.MousePointer = vbDefault
Else
MsgBox "未知錯誤！ " & vbCrLf & vbCrLf & err & “:” & Error & " ", vbExclamation
Screen.MousePointer = vbDefault
End If
End Sub

Private Sub Combo1_Click()

If kursitix.Caption <> “” Then
Set RSL = Nothing
Else
End If
’ Call excel_tallax
''srs.Open Combo1.Text, conn, adOpenKeyset, adLockOptimistic
'i = srs.Fields.Count

'For i = 0 To srs.Fields.Count - 1
'List1.AddItem srs.Fields(i).Name
'Next i
'srs.Close
'Set srs = Nothing

End Sub

Private Sub Image2_Click()
If accesstxt.Text <> “” Then accesstxt.Text = “”
For i = 0 To List2.ListCount - 1
accesstxt.Text = accesstxt.Text & List2.List(i) & “,”
Next

strsql = “select " & Left(Trim(accesstxt.Text), Len(Trim(accesstxt.Text)) - 1) & " from [” & Combo1.Text & “KaTeX parse error: Expected 'EOF', got '&' at position 37: …ECT * FROM [" &? Combo1.Text & …]”

accesstxt.Text = sql

Dim DBconn As ADODB.Connection
On Error GoTo errhandler

Set DBconn = New ADODB.Connection DBconn.CursorLocation = adUseClientSet excel_aq = New ADODB.RecordsetDBconn.Open "provider=microsoft.ace.oledb.12.0;extended properties='Excel 12.0 Xml; imex=1'; data source=" & kursitix.Caption excel_aq.Open strsql, DBconn, adOpenDynamic, adLockOptimisticSet DataGrid1.DataSource = excel_aq DataGrid1.AllowUpdate = True Cmdout.Enabled = True Exit Sub

errhandler:
If err.Number <> 0 Then
Screen.MousePointer = vbDefault
MsgBox err.Description, vbOKOnly + vbExclamation, “ImportExcelSheetData”
End If

End Sub

Private Sub Image3_Click()
Unload Me
kuznak.Show
End Sub

Private Sub List1_Click()
'用list1.list(i)可以獲取列表了某一項,i是列表項的索引,從0開始,由上到下.你的問題可以用如下代碼實現:

End Sub

Private Sub Form_Load()
Timer2.Enabled = True
Progress2.EndColor = vbRed
accesstxt.Visible = False

Call main
Dim i As Integer
sql = “select * from 學戶冊”
Dim srs As New ADODB.Recordset
srs.Open sql, myconn, adOpenDynamic, adLockOptimistic
i = srs.Fields.Count

For i = 0 To srs.Fields.Count - 1
Check1(i).Caption = srs.Fields(i).Name
Next i
srs.Close
Set srs = Nothing

End Sub
Private Sub excel_tallax()

Dim strsql As String' On Error GoTo errHandlerstrsql = "SELECT * FROM [" & Combo1.Text & "$]" excel_ulax.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=false;Data Source=" & kursitix.Caption & ";Extended Properties='Excel 8.0;HDR=Yes'"excel_ulax.Open

’ excel_ulax.ConnectionString = “Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=false;Data Source=” & kursitix.Caption & “;Extended Properties=‘Excel 14.0;’”
’ excel_ulax.CursorLocation = adUseClient
’ excel_ulax.Open “provider=microsoft.ace.oledb.12.0;extended properties=‘Excel 14.0 Xml; imex=1’; data source=” & kursitix.Caption
’ excel_ulax.Connection.CursorLocation = adUseClient

'excel_aq.Open strSQL, excel_ulax, adOpenDynamic, adLockOptimistic
excel_aq.Open “select * from [sheet1$]”, excel_ulax, adOpenKeyset, adLockOptimistic

Set DataGrid1.DataSource = excel_aqDataGrid1.AllowUpdate = TrueDataGrid1.Refresh

Exit Sub
errhandler:
If err.Number <> 0 Then
Screen.MousePointer = vbDefault
MsgBox err.Description, vbOKOnly + vbExclamation, “ImportExcelSheetData”
End If
End Sub

Private Sub Image1_Click()
Combo1.Clear
List1.Clear
List2.Clear

CommonDialog1.DialogTitle = “Open files”
'CommonDialog1.Filter = “xls files(.xls)|.xls”
CommonDialog1.Filter = “xls 文件.xls)|.xls|高版本文件(.xlsx)|.xlsx|所有文件(.)|.*”
CommonDialog1.Flags = 4 '取消 “以只讀方式打開” 復選框
CommonDialog1.ShowOpen
CommonDialog1.CancelError = True
If Len(CommonDialog1.FileName) <= 4 Then
Exit Sub
Else

kursitix.Caption = CommonDialog1.FileName

End If
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet

Set xlapp = CreateObject(“excel.application”)
Set xlbook = xlapp.Workbooks.Open(kursitix.Caption)
Set xlsheet = xlbook.Worksheets(1)
xlapp.Visible = False

'++++++ 獲取excel工作簿里的工作表名稱
For i = 1 To xlbook.Worksheets.Count
Combo1.AddItem xlbook.Worksheets(i).Name
Next i
Combo1.ListIndex = 0
For i = 1 To xlbook.Worksheets(Combo1.Text).[iv1].End(-4159).Column
List1.AddItem xlbook.Worksheets(Combo1.Text).Cells(1, i)
If Check2.Value = 1 Then List1.AddItem xlbook.Worksheets(Combo1.Text).Cells(2, i)

Next i

'++++++
xlapp.Quit

Set xlbook = NothingSet xlsheet = Nothing

Set xlapp = Nothing
Dim j As Integer
For i = 0 To List1.ListCount - 1
For j = 0 To 31
If Check1(j).Caption = List1.List(i) Then Check1(j).Value = 1
Next j
Next i
For j = 0 To 31
If Check1(j).Value = 0 Then Check1(j).Enabled = False
Next j

accesstxt.Text = accesstxt.Text & List1.List(Item) & “,”
Cmdout.Enabled = False

errhandler:

If err = 32755 Then Exit Sub '選擇了取消

End Sub

總結

以上是生活随笔為你收集整理的导入EXCEL数据更新access数据库里的信息的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。