vb中如何实现点击按钮,选择excel所在路径,利用ADO或者DATA,将excel导入access数据库中?
1个回答
2013-06-18
展开全部
之前,你必须对Excle文本的结构了解,对应的倒入你的字段!这段代可以将数据库内容倒入EXcel,你可以用它的返向操作!
Function PassToEXCEL(txt As String) As Boolean '将记录集传送到Excel关键函数
Me.MousePointer = 11
Dim xlApp As Excel.Application '定义EXCEL类
Dim xlBook As Excel.Workbook '定义工件簿类
Dim xlsheet As Excel.Worksheet '定义工作表类
Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
Set xlBook = xlApp.Workbooks.Add '打开EXCEL工作簿
Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
xlsheet.Activate
Dim rs As New ADODB.Recordset
rs.Open txt, Conn, 1, 1
Dim i As Integer
Dim j As Integer
i = 1
j = 1
If Not rs.EOF Then
With xlsheet
Do While Not rs.EOF
For j = 0 To rs.Fields.Count - 1
If Not IsNull(rs.Fields(j).Value) Then
.Cells(i, j + 1).NumberFormatLocal = "@"
.Cells(i, j + 1) = CStr(rs.Fields(j).Value)
End If
Next
i = i + 1
rs.MoveNext
Loop
.SaveAs MyPath + "database\通讯信息导出.xls"
End With
End If
rs.Close
Set rs = Nothing
Set xlsheet = Nothing
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
PassToEXCEL = True
Me.MousePointer = 0
End Function
txt是我的SQL语句,你可以改一下
Function PassToEXCEL(txt As String) As Boolean '将记录集传送到Excel关键函数
Me.MousePointer = 11
Dim xlApp As Excel.Application '定义EXCEL类
Dim xlBook As Excel.Workbook '定义工件簿类
Dim xlsheet As Excel.Worksheet '定义工作表类
Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
Set xlBook = xlApp.Workbooks.Add '打开EXCEL工作簿
Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
xlsheet.Activate
Dim rs As New ADODB.Recordset
rs.Open txt, Conn, 1, 1
Dim i As Integer
Dim j As Integer
i = 1
j = 1
If Not rs.EOF Then
With xlsheet
Do While Not rs.EOF
For j = 0 To rs.Fields.Count - 1
If Not IsNull(rs.Fields(j).Value) Then
.Cells(i, j + 1).NumberFormatLocal = "@"
.Cells(i, j + 1) = CStr(rs.Fields(j).Value)
End If
Next
i = i + 1
rs.MoveNext
Loop
.SaveAs MyPath + "database\通讯信息导出.xls"
End With
End If
rs.Close
Set rs = Nothing
Set xlsheet = Nothing
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
PassToEXCEL = True
Me.MousePointer = 0
End Function
txt是我的SQL语句,你可以改一下
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询