本文于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活学活用,更多文章敬请关注!