关于excel转入和转出的问题!欢迎各位兄弟姐妹

[MSL_monkey]

我想做一个关于excel应用的问题,要把一现有的excel报表的内容转入到程序中的表内,然后把数据存储到数据库中(sql server).同时也可以将数据库中的内容转到表中,再进一步转出excel形式.新手上路,希望各位大虾能提供部分参考代码.急ing^^^^^^^^^^^^^可以再加分^^^^^^^^^^^^祝大家五一节快乐

[xingnup]

用两个记录集打开两个数据库，然后就可以互相转换啦，例如你要将EXCEL的数据放到SQL SERVER中，循环读取EXCEL记录集的记录，再每条记录都APPEND到SQL SERVER记录集中就可以了。

----打开EXCEL表的代码:
由于以EXCEL作数据库的话,表的第一行会作为字段名,如果这一行全部为空的话,会自动以"F1,F2..."作为字段名.

你新建一个工程,引用ADO2.X,包含一个文本框TEXT1,一个DATAGRID1.然后代码如下:
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sCN As String
Dim sSQL As String

sCN = "Provider=MSDASQL.1;Driver={Microsoft Excel Driver (*.xls)};DBQ=c:\test.xls"
cn.Open sCN

sSQL = "select * from [sheet1$]"

rs.Open sSQL, cn, adOpenStatic, adLockOptimistic


----注意，如果你要在第一行处作为字段名，记得字段名是以字母开头的，不用随便用全部数字作字段名。


SQL Server比较少用，所以不记得了，步骤差不多，只是数据库引擎的名称不同。

[MSL_monkey]

up

[mndsoft]

到我的blog上找找吧

[pxmboy]

给你我自己程序里的两个函数，主要功能差不多，可能根据实际需要再修改一点
'***************************************************************
'函数名：SaveGrid
'功能介绍：把文件导出到Excel表中
'参数说明：
'更新时间：2004-6-1

'***************************************************************

Public Sub SaveGrid(ByVal strHead As String, ByVal strTail As String, GridName As MSFlexGrid, ByVal Cmdiag As CommonDialog)
Dim xlApp As New Excel.Application
Dim xlBook As New Excel.Workbook
Dim xlSheet As New Excel.Worksheet
Dim CmDiag1 As CommonDialog
Dim Loopi As Integer
Dim Loopj As Integer
Dim fileName As String

' Set CmDiag1 = Cmdiag
With Cmdiag
.fileName = ""
.DialogTitle = "输出到文件"
.CancelError = False
'设置 common dialog 控件的标志和属性
.Filter = "Mirosoft Excel 文件 (*.XLS)|*.xls"
.ShowSave
If .CancelError Then Exit Sub

If Len(.fileName) = 0 Then
Exit Sub
End If
fileName = .fileName
End With


Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(0)


With GridName
xlSheet.Cells(1, 1) = strHead
For Loopi = 0 To .Rows - 1
For Loopj = 0 To .Cols - 1

xlSheet.Cells(Loopi + 1, Loopj + 1) = .TextMatrix(Loopi, Loopj)
Next Loopj
Next Loopi
End With
xlSheet.Cells(Loopi + 2, 1) = strTail
On Error GoTo Err
xlBook.SaveAs fileName

xlBook.Close False

Set xlBook = Nothing
Set xlApp = Nothing
MsgBox "成功输出", vbInformation + vbOKOnly, "输出"
Exit Sub
Err:
If Err <> 0 Then
MsgBox "导出数据失败,错误描述：" & Err.Number & ":" & Err.Description, vbOKOnly
' Resume Next
End If
DoEvents
End Sub

'***************************************************************
'函数名：InputExl
'功能介绍：把Excel文件导入到表中
'参数说明：
'更新时间：2004-6-1
'***************************************************************

Public Sub InputExl(ByVal GridName As MSFlexGrid, ByVal Cmdiag As CommonDialog)
Dim xlApp As New Excel.Application
Dim xlBook As New Excel.Workbook
Dim xlSheet As New Excel.Worksheet
Dim fileName As String
Dim Loopi As Integer
Dim Loopj As Integer

With Cmdiag
.fileName = ""
.DialogTitle = "选择输入文件"
.CancelError = False
'设置 common dialog 控件的标志和属性
.Filter = "Mirosoft Excel 文件 (*.XLS)|*.xls"
.ShowOpen
If Len(.fileName) = 0 Then
Exit Sub
End If
fileName = .fileName
End With

If Trim(Cmdiag.fileName) = "" Then Exit Sub
fileName = Cmdiag.fileName

Set xlBook = xlApp.Workbooks.Open(fileName)
Set xlSheet = xlBook.ActiveSheet


On Error Resume Next
For Loopi = 10 To 27 '这两行是特定程序使用的,你可以做修改 换成其他,或者删除
For Loopj = 2 To 9 '这两行是特定程序使用的,你可以做修改 换成其他,或者删除

If Loopi - 9 >= GridName.Rows Then GridName.Rows = GridName.Rows + 1 '如果GridName的行数小于Excle的行数,则增加一行
GridName.TextMatrix(Loopi - 9, Loopj - 2) = xlSheet.Cells(Loopi, Loopj)
If Loopj - 2 > 1 Then
GridName.TextMatrix(Loopi - 9, Loopj - 2) = Format(GridName.TextMatrix(Loopi - 9, Loopj - 2), "############0.00")
End If
Next


GridName.TextMatrix(Loopi - 9, 8) = xlSheet.Cells(Loopi, 13)
Next
GridName.TextMatrix(0, 8) = "备注"


Set xlSheet = Nothing
xlBook.Close False
Set xlBook = Nothing

xlApp.Quit
Set xlApp = Nothing
End Sub

[MSL_monkey]

UP

[cxianfa]

我给你一点代码试试看把。是sql导入excel的。希望对你有帮助
If exlapp.Visible = True Then exlapp.Visible = False
Set exlapp = New excel.Application
exlapp.Workbooks.Open App.Path & "\Bookjbzl.xlt"
Set rs = New ADODB.Recordset
Set cnn = New ADODB.Connection
With cnn
.Provider = "SQLOLEDB"
.ConnectionString = "User ID=sa;Pwd=sa;" & _
"Initial Catalog=jwlExpert"
.CursorLocation = adUseClient
.Open
End With
txtSQL = "select * from p_Info"
If rs.State = adStateOpen Then rs.Close
rs.Open txtSQL, cnn, adOpenStatic, adLockOptimistic
If rs.RecordCount < 1 Then
MsgBox ("没有记录")
Exit Sub
Else
iRowcount = 3
While Not rs.EOF
With exlapp.Sheets(1)
.Cells(iRowcount, 1) = rs.Fields(0)
.Cells(iRowcount, 2) = rs.Fields(1)
.Cells(iRowcount, 3) = rs.Fields(2)
.Cells(iRowcount, 4) = rs.Fields(3)
.Cells(iRowcount, 5) = rs.Fields(4)
.Cells(iRowcount, 6) = rs.Fields(5)
.Cells(iRowcount, 7) = rs.Fields(6)
.Cells(iRowcount, 8) = rs.Fields(7)
.Cells(iRowcount, 9) = rs.Fields(8)
.Cells(iRowcount, 10) = rs.Fields(9)
.Cells(iRowcount, 11) = rs.Fields(10)
rs.MoveNext
iRowcount = iRowcount + 1
End With
Wend
exlapp.Visible = True
rs.Close
Set cnn = Nothing
End If

[cxianfa]

你可以到网站上去搜索一下，很多的。我再给你一个网址：http://blog.csdn.net/error.aspx?aspxerrorpath=/lihonggen0/archive/2002/09/05/13624.aspx

[MSL_monkey]

自己顶 大家多帮忙!!急!