VB 怎么根据条件用ADODB从Access导入到Excel中
本帖最后由 mpy2003 于 2013-03-28 12:59:19 编辑 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这一行记录因为字段"设计"不是空的，所以也不导入，依此类推
麻烦能给详细的程序，正在学习阶段，谢谢 access excel vb 条件 ADODB
[解决办法]
'标准模块中代码：
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
