咔片PPT · AI自动生成演示文稿,模板丰富、排版精美 讯飞智文 · 一键生成PPT和Word,高效应对学习与办公

​​​本文于2023年4月23日首发于本人同名公众号:Excel活学活用,更多文章敬请关注!

数据导入核心代码,CmdImport_Click(),代码可能有一些无效语句,没有来得及整理,大家将就着看吧,关键是思路。

Private Sub CmdImport_Click() ThisWorkbook.Activate If Not wContinue("即将导入!" & Chr(10) _ & "勾选【追加】则保留原有数据" & Chr(10) _ & " 不勾【追加】则删除原有数据!" _ & Chr(10) & " 请谨慎操作!") Then Exit Sub 'On Error Resume Next Dim arrT(), arr() Dim iPath As String Dim iSheet As Worksheet Dim CurrTable As String Dim tbTitle() Dim cnn As Object '数据库连接 Dim rs As Object Dim StrCnn As String 'ACCESS连接语句 Dim mydata As String '数据库的完整路径和名称 Dim aData() Dim FieldsNum As Integer Set cnn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") Psw = clsGT.GetPsW StrCnn = clsGT.GetStrCnn(DataFile, Psw) cnn.Open StrCnn '打开数据库链接 If Me.CkB_Add.Value = True Then For Each LvItem In Me.LvSelected.ListItems CurrTable = LvItem.Text SQL1 = " select * from [Excel 12.0;DataBase=" & sFile & "].[" & CurrTable & "$]" arrT = clsDQ.GetData(SQL1) rs.Open CurrTable, cnn, 1, 3 For i = 0 To UBound(arrT, 2) If arrT(1, i) = "" Then Exit For rs.AddNew For j = 1 To UBound(arrT, 1) rs.Fields(j) = arrT(j, i) Next rs.Update Next Next Else If Not wContinue("即将删除原有数据,添加新数据!") Then Exit Sub For Each LvItem In Me.LvSelected.ListItems CurrTable = LvItem.Text sql = "delete * from " & CurrTable clsDQ.ExecuteSQL (sql) sql = "ALTER TABLE " & CurrTable & " ALTER COLUMN ID COUNTER(1,1)" '重置ID计数器 clsDQ.ExecuteSQL (sql) SQL1 = " select * from [Excel 12.0;DataBase=" & sFile & "].[" & CurrTable & "$]" arrT = clsDQ.GetData(SQL1) tbTitle = clsDQ.GetFields(SQL1) rs.Open CurrTable, cnn, 1, 3 For i = 0 To UBound(arrT, 2) If arrT(1, i) = "" Then Exit For rs.AddNew For j = 1 To UBound(arrT, 1) rs.Fields(tbTitle(j)) = arrT(j, i) Next rs.Update Next rs.Close Next End If Application.DisplayAlerts = False MsgBox ("导入成功!") '关闭打开的导入源文件(打开后是隐藏的,没有关闭它会造成一些问题 '从完整径中截取文件名 sFile = Mid(sFile, InStrRev(sFile, "") + 1, Len(sFile) - InStrRev(sFile, "")) Workbooks(sFile).Close SaveChanges:=False Application.DisplayAlerts = True cnn.Close Set cnn = Nothing Set rs = Nothing Unload Me End Sub

​​​​本文于2023年4月23日首发于本人同名公众号:Excel活学活用,更多文章敬请关注!