VB 怎么根据条件用ADODB从Access导入到Excel中

浩洁 2013-03-28 12:24:57
Access字段：编号 型号 类别 设计 下单时间 完成时间
C01 MMM F 2013-3-1
C02 WWN E 2013-3-1
C03 WBN D 张三 2013-3-1 2013-3-5
C04 BWN E 2013-3-1

Excel中结构：A列 B列 C列 D列 E列 F列
1 编号 型号 类别 设计 下单时间 完成时间
2 C01 MMM F 2013-3-1
3

先判断Access中字段“设计”为空也就是没内容的时候，并且这一行的记录字段“编号”在Excel中A列不存在时，导入到Excel中A列，则Access查下一行记录
如上面的数据就是Access中C01这行记录就不会导入，而C02这行记录会导入，C03这一行记录因为字段"设计"不是空的，所以也不导入，依此类推
麻烦能给详细的程序，正在学习阶段，谢谢
...全文
2780 33 打赏 收藏 转发到动态 举报
写回复
用AI写文章
33 条回复
切换为时间正序
请发表友善的回复…
发表回复
浩洁 2013-03-29
  • 打赏
  • 举报
 回复
引用 32 楼 yuexiashi 的回复:
要不然就把你的程序发给我来调试一下看看
Option Explicit     '强制定义变量名
Public i As Long
Public n As Long
Public xlapp As Object      'Excel 对象
Public xlbook As Object     '工作簿
Public xlsheet As Object    '工作表
Public Function UpdateBom()
    Set con = New ADODB.Connection
    Set res = New ADODB.Recordset
    con.Open "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & App.Path & "\Data.accdb"
    Set xlapp = CreateObject("Excel.Application")
    Set xlbook = xlapp.Workbooks.Open(SystemSet.DesignXL)
    Set xlsheet = xlbook.Worksheets("任务表")
    xlapp.Visible = False
    GToS (DAT)
    xlapp.Quit
    If res.State = adStateOpen Then res.Close
    If con.State = adStateOpen Then con.Close
    Set xlapp = Nothing
    Set res = Nothing
    Set con = Nothing
End Function
Public Function GToS(ByVal DAT As String) As ADODB.Recordset        '从工作表更新到数据库
    n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
    For i = 2 To n
        SystemSet.Progress.Value = i
        If xlsheet.Cells(i, 8) <> "" Then
            res.Open "select * from 新油缸目录 where 编号='" & xlsheet.Cells(i, 1).Value & " '", con, 3, 3
            res.Fields("型号") = xlsheet.Cells(i, 2).Value
            res.Fields("类别") = xlsheet.Cells(i, 3).Value
            res.Fields("设计") = xlsheet.Cells(i, 4).Value
            res.Fields("时间") = xlsheet.Cells(i, 5).Value
            res.Fields("信息") = xlsheet.Cells(i, 9).Value
            res.Update
            res.Close
            xlsheet.Rows(CStr(i) & ":" & CStr(i)).Select
            Selection.ClearContents
        End If
    Next i
    xlsheet.Range("A2:M" & n).Sort key1:=xlsheet.Range("A2"), order1:=xlAscending
    xlbook.Save
    If res.State = adStateOpen Then res.Close
End Function
我只能做到这样了
浩洁 2013-03-29
  • 打赏
  • 举报
 回复
引用 28 楼 yuexiashi 的回复:
那你就再发个帖问问怎么优化提速吧，，这个我只能做到这样了，，我也只是个新手
我知道了可能是因为Next i下面行没有加Exit Do的原因吧 
        Next i
        Exit Do
yuexiashi 2013-03-29
  • 打赏
  • 举报
 回复
那你就再发个帖问问怎么优化提速吧，，这个我只能做到这样了，，我也只是个新手
yuexiashi 2013-03-29
  • 打赏
  • 举报
 回复
要不然就把你的程序发给我来调试一下看看
yuexiashi 2013-03-29
  • 打赏
  • 举报
 回复
在循环当中，n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count这个值好像是不可以修改的，，
yuexiashi 2013-03-29
  • 打赏
  • 举报
 回复
那你就不要DO啊，你的DO是为了判断什么东西
浩洁 2013-03-28
  • 打赏
  • 举报
 回复
引用 25 楼 yuexiashi 的回复:
Visual Basic code?12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667'标准模块中代码：Public con As New ADODB.Connection ……
速度差不多
yuexiashi 2013-03-28
  • 打赏
  • 举报
 回复
Set res = cn.Execute("UPDATE 目录 SET 类别='" + 改成(忘了修改) Set res = con.Execute("UPDATE 目录 SET 类别='" +
yuexiashi 2013-03-28
  • 打赏
  • 举报
 回复 

'标准模块中代码：
Public con As New ADODB.Connection      '定义一个数据连接New ADODB.
Public res As New ADODB.Recordset        '定义一个数据集对象New ADODB.
Public Sub dbopen(dbmc As String)             '定义一个公共主函数，用于连接数据库
    Dim temp As String
    temp = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\" & dbmc  & ". accdb;Peresist Security Info=true"
    con.Open (temp)
    
End Sub
Public Sub resclose(res As Recordset)
    If res.State = adStateOpen Then
    '打开
        res.Close
    Else
    '
    End If
End Sub
Public Sub dbclose(con As Connection)
    If con.State = adStateOpen Then
        con.Close
    Else
        
    End If
End Sub
'form load中代码:在软件启动时打开数据库
Private Sub Form_Load()
'关闭已打开的数据库
    Call resclose(res)
    Call dbclose(con)
'打开数据库
    Call dbopen("Data")

End Sub
Private Sub Form_Unload(Cancel As Integer)   '退出软件时才关闭数据库和记录集
    Call resclose(res)
    Call dbclose(con)
    
    End
End Sub
'修改你的代码：
Public Function GToS(ByVal DT As String) As ADODB.Recordset       '从工作表更新到数据库
    On Error Resume Next
    Set xlapp = CreateObject("Excel.Application")
    Set xlbook = xlapp.Workbooks.Open(SystemSet.DesignXL)
    Set xlsheet = xlbook.Worksheets("任务表")
    xlapp.Visible = False
    
    n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
    YesNo = True
    Do While YesNo
        YesNo = False
        For i = 2 To n
            If xlsheet.Cells(i, 7).Value <> "" Then
   '修改指定表中纪录
      Set res = cn.Execute("UPDATE 目录 SET 类别='" + xlsheet.Cells(i, 3).Value + "', 设计='" + xlsheet.Cells(i, 4).Value + "', 信息='" + xlsheet.Cells(i, 9).Value + "'  where 编号='"+ xlsheet.Cells(i, 1).Value +"'")
                xlsheet.Rows(CStr(i) & ":" & CStr(i)).Select
                Selection.Delete Shift:=xlUp
                n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
                YesNo = True
            End If
        Next i
    Loop
    xlbook.Close True
    xlapp.Quit
    Set xlapp = Nothing
    
End Function
你测试一下看看！！
浩洁 2013-03-28
  • 打赏
  • 举报
 回复
引用 21 楼 yuexiashi 的回复:
另外，你的数据库不要总是打开，又关闭，，记录集也是，不停的打开关闭，这样操作肯定慢了
我是刚学没多久，能用你的方法把我那段程序改一个完整的吗？谢谢了我想看全过程可能能更明白一些怎么用的
yuexiashi 2013-03-28
  • 打赏
  • 举报
 回复
等下，过半个小时吧，现在有点事
浩洁 2013-03-28
  • 打赏
  • 举报
 回复
引用 20 楼 yuexiashi 的回复:
Visual Basic code?1234567891011 Public cn As New ADODB.Connection '定义一个数据连接New ADODB. Public rs As New ADODB.Recordset '定义一个数据集对象New ADODB. '查询纪录 sql = "se……
谢谢你，我还看不懂这个取值，你能不能根据我那个代码里的字段名和对应表格编一下？
yuexiashi 2013-03-28
  • 打赏
  • 举报
 回复
另外，你的数据库不要总是打开，又关闭，，记录集也是，不停的打开关闭，这样操作肯定慢了
yuexiashi 2013-03-28
  • 打赏
  • 举报
 回复 

      Public cn As New ADODB.Connection      '定义一个数据连接New ADODB.
      Public rs As New ADODB.Recordset        '定义一个数据集对象New ADODB.
      '查询纪录
      sql = "select * from tb_gys " + " order by 客户编码"
      '打开记录集
      Set rs = cn.Execute(sql)
      s1=rs.Fields("设计")
     '往指定表中添加新纪录
      Set rs = cn.Execute("insert into tb_jljl(字段1,字段2) values(" & StrNum & ",'" & Text1(0).Text & "')")
     '修改指定表中纪录
      Set rs = cn.Execute("UPDATE tb_zcsz SET 字段1='" + txtFields(1).Text + "',字段2='" + txtFields(2).Text + "'  where 字段1='"+"com"+"'")
yuexiashi 2013-03-28
  • 打赏
  • 举报
 回复 


'往指定表中添加新纪录
Set rs = cn.Execute("insert into tb_jljl(字段1,字段2) values(" & StrNum & ",'" & Text1(0).Text & "')")
'修改指定表中纪录
    Set rs = cn.Execute("UPDATE tb_zcsz SET 字段1='" + txtFields(1).Text + "',字段2='" + txtFields(2).Text + "'  where 字段1='"+"com"+"'")
使用SQL语句可能更好一点吧，，
浩洁 2013-03-28
  • 打赏
  • 举报
 回复
引用 17 楼 yuexiashi 的回复:
哪出错了，？
没有出现错误，只是我觉得速度好慢，不知道是不是哪里有过多的计算量不？
yuexiashi 2013-03-28
  • 打赏
  • 举报
 回复
哪出错了，？
浩洁 2013-03-28
  • 打赏
  • 举报
 回复 
Public Function GToS(ByVal DT As String) As ADODB.Recordset       '从工作表更新到数据库
    Set con = New ADODB.Connection
    Set res = New ADODB.Recordset
    On Error Resume Next
    Set xlapp = CreateObject("Excel.Application")
    Set xlbook = xlapp.Workbooks.Open(SystemSet.DesignXL)
    Set xlsheet = xlbook.Worksheets("任务表")
    xlapp.Visible = False
    con.Open "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & App.Path & "\Data.accdb"
    res.Open "select * from 目录", con, 3, 3
    res.Close
    n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
    YesNo = True
    Do While YesNo
        YesNo = False
        For i = 2 To n
            If xlsheet.Cells(i, 7).Value <> "" Then
                res.Open "select * from 目录 where 编号='" & xlsheet.Cells(i, 1).Value & " '", con, 3, 3
                res.Fields("类别") = xlsheet.Cells(i, 3).Value
                res.Fields("设计") = xlsheet.Cells(i, 4).Value
                res.Fields("信息") = xlsheet.Cells(i, 9).Value
                res.Update
                res.Close
                xlsheet.Rows(CStr(i) & ":" & CStr(i)).Select
                Selection.Delete Shift:=xlUp
                n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
                YesNo = True
            End If
        Next i
    Loop
    xlbook.Close True
    xlapp.Quit
    Set xlapp = Nothing
    Set res = Nothing
    Set con = Nothing
End Function
这段程序我是参考了别人的改的，不知道是不是很麻烦或有错误，请帮我
yuexiashi 2013-03-28
  • 打赏
  • 举报
 回复
yuexiashi 2013-03-28
  • 打赏
  • 举报
 回复
这个实例，'从excel导出到 access中，会出现表“表名1”已存在的问题，，你怎么解决的，，其实我是个新手，只是刚开发了一个关于数据库操作的软件，还没涉及到EXCEL的内容。。我都是直接操作数据库的，
加载更多回复（13）
vb excel 导入 access
Dim extend_str As String Dim execl_cnn As New ADODB.Connection Dim execl_rst As New ADODB.Recordset Dim execl_count_rst As New ADODB.Recordset '纪录数量 Dim execl_field_rst As New ADODB.Recordset Dim execl_strconn As String Dim execl_strcmd As String Dim execl_count_str As String Dim insertStr As String 操作oracle数据库的记录集 Dim rst As ADODB.Recordset CommonDialog1.ShowOpen extend_str = Right(CommonDialog1.FileName, 3) If (extend_str = "xls") Then execl_cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & CommonDialog1.FileName & _ ";Extended Properties=Excel 8.0;" ElseIf (extend_str = "dbf") Then execl_cnn.ConnectionString = "Provider=MSDASQL.1;Driver=Microsoft Visual Foxpro Driver;SourceType=DBF;DBQ=" & getDir (CommonDialog1.FileName) execl_cnn.Open End If If (extend_str = "xls") Then execl_strcmd = "SELECT * from `Sheet1$` " execl_count_str = "SELECT count(*) from `Sheet1$` " execl_field_rst.Open execl_count_str, execl_cnn If (execl_field_rst.Fields(0).Value = 0) Then execl_strcmd = "SELECT * from [" & getFileNoExt(getfile(CommonDialog1.FileName)) & "$] " execl_count_str = "SELECT count(*) from [" & getFileNoExt(getfile(CommonDialog1.FileName)) & "$] " End If execl_field_rst.Close ElseIf (extend_str = "dbf") Then execl_strcmd = "SELECT * from " & CommonDialog1.FileName execl_count_str = "SELECT count(*) from " & CommonDialog1.FileName End If execl_rst.Open execl_strcmd, execl_cnn execl_count_rst.Open execl_count_str, execl_cnn If (CommonDialog1.FileName "") Then '进度条设置 ProgressBar1.Min = 0 ProgressBar1.max = execl_count_rst.Fields(0).Value If (execl_rst.RecordCount) Then '如果有记录 If (Option1.Value) Then '如果是仪器总库 If (execl_rst.Fields.Count = 8) Then Set rst = yg_gain_table_recordset("yg_device") execl_rst.MoveFirst Do While (Not execl_rst.EOF) rst.AddNew rst.Fields(0).Value = yg_getNextId("yg_device_id") rst.Fields(1).Value = execl_rst.Fields(0).Value & "" rst.Fields(2).Value = execl_r
VB把excel数据导入ACCESS
Dim SQL As String Dim conn As ADODB.Connection Set conn = New ADODB.Connection Dim Constr As String Constr = "PROVIDER = Microsoft.Jet.OLEDB.4.0;" & "Data Source=c:\db.mdb" conn.Open Constr SQL
如何用VBA语言把EXCEL导入ACCESS中
为了在 Excel 中使用 VBA 将数据导入 Access，您需要执行以下步骤： 在 Excel 中打开 VBA 编辑器。 在编辑器中，在左侧资源管理器中双击 “模块”。 现在，在模块窗口中输入以下代码： Sub ExportToAccess() ' Declare variables Dim cn As ADODB.Connection Dim rs As ADODB.Record...
VB 把excel中内容添加到access中
除了access可以从excel直接导入（有点不符合本人观点）外， 可以用VB来操作。 两个注意点： 1、先查询记录在access是否存在，存在了就不用添加。 2、打开时，用键集游标adOpenKeyset，不然那个查询的记录集的个数是-1，为判断是否存在记录造成困惑。 Private Sub Command1_Click() Dim cn As New A
用VBA把EXCEL表导入ACCESS数据库中
首先在指定的access数据库的建立一张表，表格的字段和需要导入EXCEL表的字段保持一致。   方法一：在eccel VBA编辑器编写代码，使用FOR循环导入： Sub 利用Excel的VBA将数据写入Access()     '定义ADODB 连接Access数据库     Dim Cnn As New ADODB.Connection     Dim Rs As New ADODB
VB基础类

7,763

社区成员

197,605

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章