excel数据导入SQL,编号单元格重复的则覆盖，不重复的则追加,如何实现?

zhangjimfu · 发表于 2011-8-2 09:10

代码供参考!

Sub UploadNoteExcelObject(mth As String, myPath As String, sRow As Integer)
'添加或更新Excel文件导入记录
Dim OpenWorkbook As New Excel.workbook, sql$, i%, dbs As Database, UploadPerson$ '定义变量
Dim StoreNumber$, Times$, StoreBrand$, FinMonth%, FinYear%, Update#, State$, ReportKind$
On Error Resume Next '容错代码
Set OpenWorkbook = GetObject(myPath) '打开Excel文件
With OpenWorkbook.Sheets("Help") '简化代码
StoreNumber = .Range("b4") '从Help工作表中B4单元格获取门店编号
StoreBrand = .Range("f4") '从Help工作表中f4单元格获取门店品牌
FinMonth = .Range("j4") '从Help工作表中j4单元格获取导入月份
FinYear = .Range("e2") '从Help工作表中e2单元格获取导入年份
ReportKind = .Range("e4") '从Help工作表中e4单元格获取报表性质
Update = Date '添加或更新记录日期
UploadPerson = Environ("UserName") '添加或更新或上传记录人
End With
OpenWorkbook.Close '关闭Excel文件
State = DLookup("State", "tblUploadNote", "StoreNumber='" & StoreNumber & "' And StoreBrand='" & StoreBrand _
& "' And ReportKind='" & ReportKind & "' And FinYear=" & FinYear & " And FinMonth=" & FinMonth)
'根据从Excel文件中获取的信息,查询出Access文件tblUploadNote的门店审核状态
If State = "已审核" Then
MsgBox StoreNumber & Chr(10) & "报表已审核,数据将被忽略!" '提示用户报表审核状态
Exit Sub '判断状态是否已审核,是则退出程序
End If
Set dbs = CurrentDb '为变量赋值
If Len(State) > 0 Then '判断门店是否有导入过,是则更新记录,否则新增记录
i = DLookup("Times", "tblUploadNote", "StoreNumber='" & StoreNumber & "' and FinYear=" & FinYear & " And FinMonth=" & FinMonth _
& " And ReportKind='" & ReportKind & "' And StoreBrand='" & StoreBrand & "'") + 1
'获得最新的导入次数
sql = "Update tblUploadNote Set [Update]=" & Update & ",Times=" & i & ",UploadPerson='" & UploadPerson & "' Where StoreNumber='" & StoreNumber & "' And FinYear=" _
& FinYear & " and FinMonth=" & FinMonth & " and ReportKind='" & ReportKind & "' And StoreBrand='" & StoreBrand & "'"
'更新导入日期与导入次数
Else
sql = "Insert into tblUploadNote(StoreNumber,StoreBrand,ReportKind,FinYear,FinMonth,[Update],Times,UploadPerson) Values('" _
& StoreNumber & "','" & StoreBrand & "','" & ReportKind & "'," & FinYear & "," & FinMonth & "," & Update & "," & 1 & ",'" & UploadPerson & "')"
'新增记录
End If
DoCmd.RunSQL sql '执行sql语句,将Excel文件数据更新或新增到Access的tblUploadNote表中
Set OpenWorkbook = Nothing '适放对象
Set dbs = Nothing '适放对象
Call UploadBSAndPL(myPath) '调用UploadBSAndPL程序
Call UploadCF(mth, myPath) '调用UploadCF程序
Call UpdateBSAndPL(mth, sRow) '调用UpdateBSAndPL程序
End Sub

复制代码

2217918 · 发表于 2011-8-2 09:25

能否提供附件供我学习，非常感谢！

zhangjimfu · 发表于 2011-8-2 09:43

我的附件太大不好上传,把你的附件传上来吧,我在你的基础上改

2217918 · 发表于 2011-8-2 09:49

好的，非常感谢，我已经上传附件了

2217918 · 发表于 2011-8-2 09:59

阿发在吗？

zhangjimfu · 发表于 2011-8-2 13:35

Sub Test()
Dim conn, rst, sql$, i As Single
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset"): i = 2
On Error Resume Next
conn.Open "Provider=Microsoft.Jet.Oledb.4.0;Data Source=" & ThisWorkbook.Path & "\Test.mdb"
While Cells(i, 3) <> ""
sql = "Select 编号 From tblTest" & " Where 编号=" & Cells(i, 2)
Set rst = conn.Execute(sql)
sql = "Update tblTest Set 路数=" & Cells(i, "j") & " Where 编号=" & Cells(i, 2)
conn.Execute (sql)
If rst.EOF Then
Err.Clear
sql = "Insert into tblTest( 编号,路数) Values(" & Cells(i, 2) & "," & Cells(i, "j") & ")"
conn.Execute (sql)
End If
i = i + 1
Wend
conn.Close
Set conn = Nothing
Set rst = Nothing
End Sub

复制代码

1.rar (60.44 KB, 下载次数: 115)

代码供参考!

sunsoncheng · 发表于 2011-8-4 00:45

简单的处理下?如果你的数据不会变更的话
在M列加入标识,已录入

...........................
If wkSheet.Cells(i, 2).Value <> 0 Then
      if  wkSheet.Cells(i, "M").Value <>"已录入" then
                        wkSheet.Cells(i, "M").Value ="已录入"
                  后面的基本不用改,直接加入end if 就行了

            '拼写INSERT语句的SQL语句
            strTemp = "insert into 物资信息 (编号,材质楞型,楞别,班组,类别,长度,宽度,门幅,路数,订单数,入库数) "

sunsoncheng · 发表于 2011-8-4 01:01

如下会有结果吧
如果数据都已录入数据库了还要保存文件干吗?用时提取出来就是了

Sub qqq1()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i%, strTemp$, RowNum%, K%
Dim wkSheet As Worksheet
If MsgBox("确认要导入数据吗？", vbYesNo) = 7 Then Exit Sub
'建立与SQL的连接
conn.Open "Driver={SQL Server};server=192.168.107.111;uid=sa;pwd=sa;database=JSSY;"
Application.ScreenUpdating = False
Set wkSheet = Worksheets("原始数据")

On Error GoTo 9
conn.BeginTrans
      K = 0
      With wkSheet
      RowNum = .Range("c65536").End(xlUp).Row
      For i = 2 To RowNum
         If .Cells(i, 2).Value <> 0 Then
            If .Cells(i, "M").Value <> "已录入" Then
                  Dim SQL$
                  SQL = "select 编号 from 物资信息 where 编号 ='" & .Cells(i, 2).Value & "'"
                  Set rs = Nothing
'这里要加一句

      rs.open sql,conn,1,1,1

                  If rs.RecordCount > 1 Then '存在旧的号的话就删除
                     conn.Execute "delete 物资信息 where 编号 ='" & .Cells(i, 2).Value & "'"
                  End If

                  '拼写INSERT语句的SQL语句
                  strTemp = "insert into 物资信息 (编号,材质楞型,楞别,班组,类别,长度,宽度,门幅,路数,订单数,入库数) "
                  strTemp = strTemp & " values( '" & .Cells(i, 2).Value & "'  ,  '" & _
                                                   .Cells(i, 3).Value & "'  ,  '" & _
                                                   .Cells(i, 4).Value & "'  ,  '" & _
                                                   .Cells(i, 5).Value & "'  ,  '" & _
                                                   .Cells(i, 6).Value & "'  ,  '" & _
                                                   .Cells(i, 7).Value & "'  ,  '" & _
                                                   .Cells(i, 8).Value & "'  ,  '" & _
                                                   .Cells(i, 9).Value & "'  ,  '" & _
                                                   .Cells(i, 10).Value & "'  ,  '" & _
                                                   .Cells(i, 11).Value & "'  ,  '" & _
                                                   .Cells(i, 12).Value & "')"
                  '执行INSERT语句
                  conn.Execute strTemp
                  K = K + 1
               .Cells(i, "M").Value = "已录入"       '防止重复比较加快录入速度
            End If
         End If
      Next
      End With
conn.CommitTrans       '结束插入操作的事务
On Error GoTo 0
ThisWorkbook.Save
'显示已经插入的记录条数
conn.Close             '关闭链接
Set rs = Nothing       '释放内存
Set conn = Nothing    '释放内存

Set wkSheet = Nothing
Application.ScreenUpdating = True

MsgBox "导入完毕！" & Chr(10) & Chr(10) & "已经插入的条数：" & K
Exit Sub
9:
conn.RollbackTrans
MsgBox Err.Description & "第" & i & "行导入出错"

End Sub

[ 本帖最后由 sunsoncheng 于 2011-8-4 08:11 编辑 ]

2217918 · 发表于 2011-8-4 08:05

出现以下错误，请帮忙看看。

sunsoncheng · 发表于 2011-8-4 08:13

'这里要加一句
rs.open sql,conn,1,1,1

头晕了，应是加一句的：）

		自动登录	找回密码
密码			免费注册

[求助] excel数据导入SQL,编号单元格重复的则覆盖，不重复的则追加,如何实现?

回复 12楼 2217918 的帖子