Private Sub XLS()
Dim app As Excel.Application '定义变量
Set app = New Excel.Application
Dim eworkbook As Workbook
Dim eworksheet As Worksheet
Dim A1
Dim A2
Dim A3 Dim nfile As Integer
Dim N As Integer
Dim M As Integer
dim All As integer
nfile = FreeFile
On Error GoTo NotFindErr
Set eworkbook = app.Workbooks.Open(文件名) '打开文件
N = 2
Do
M = 1
Do While M < i ' i 表示xls文件的列数
Set eworksheet = eworkbook.Sheets(nfile)
Set All = eworksheet.Cells(N, M) '读取数据
Select Case M
Case 0
A1 = All
Case 1
A2 = All
Case 2
A3 = All
End Select
M = M + 1
Loop
Adodc1.Refresh
Adodc1.Recordset.AddNew
Adodc1.Recordset("file1") = A1
Adodc1.Recordset("file2") = A2
Adodc1.Recordset("file3") = A3
Adodc1.Recordset.Update
N = N + 1
Loop Until A1 = "" And A2 = "" And A3 = ""
Set eworksheet = Nothing
Set eworkbook = Nothing
app.quit
MsgBox "数据导入完毕"
End Sub
试试吧!!!
Dim app As Excel.Application '定义变量
Set app = New Excel.Application
Dim eworkbook As Workbook
Dim eworksheet As Worksheet
Dim A1
Dim A2
Dim A3 Dim nfile As Integer
Dim N As Integer
Dim M As Integer
dim All As integer
nfile = FreeFile
On Error GoTo NotFindErr
Set eworkbook = app.Workbooks.Open(文件名) '打开文件
N = 2
Do
M = 1
Do While M < i ' i 表示xls文件的列数
Set eworksheet = eworkbook.Sheets(nfile)
Set All = eworksheet.Cells(N, M) '读取数据
Select Case M
Case 0
A1 = All
Case 1
A2 = All
Case 2
A3 = All
End Select
M = M + 1
Loop
Adodc1.Refresh
Adodc1.Recordset.AddNew
Adodc1.Recordset("file1") = A1
Adodc1.Recordset("file2") = A2
Adodc1.Recordset("file3") = A3
Adodc1.Recordset.Update
N = N + 1
Loop Until A1 = "" And A2 = "" And A3 = ""
Set eworksheet = Nothing
Set eworkbook = Nothing
app.quit
MsgBox "数据导入完毕"
End Sub
试试吧!!!
解决方案 »
- 程序员未来走势及抉择
- 这是我用循环缓存来播放WAV文件的程序。。但是播放时有间隙
- 求救.........高手快来 !!!
- 有人知道AVIStreamRead第四个参数如何定义吗?
- “操作符 AddressOf 使用无效”问题提示,高手看一下。
- 打印机对象的问题?
- 请问界面显示问题,程序界面上的字体在2000下显示正常,到了98下就看不清了,怎么回事呢?
- 程序运行出错,各位帮忙看一下!
- HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run 已经注册执行程序 但不启动
- 100分在线询问:在查询结果中对recordset插入,删除,更改。
- 我需要一个单向传输文件的例子,紧急需求!这是我现在的最高分了!
- 关于DATAGRID 的打印!!
'定义数据库记录集及Excel对象变量
Public ex As New Excel.Application
Public exwbook As Excel.Workbook
Public exsheet As Excel.Worksheet
Public mydatabase As Database
Public myrecordset1 As Recordset
[定义记录集]
……
……
Public Opt As Integer '报表选项
[Opt为frmSelreport.frm返回值]
Public isYN As Boolean
Sub Main()
Load frmSplash
frmSplash.Show
frmSplash.Label2.Caption =
" 系统正在加载Access数据库..."
Set mydatabase = OpenDatabase("c:\sbda\sbda.mdb")
Set myrecordset1 = mydatabase.OpenRecordset
("报表打印(一)")
[此处对记录集赋值]
……
……
frmSplash.Label2.Caption =
" 系统正在加载Excel电子表格..."
Set ex = CreateObject("excel.application")
Set exwbook = ex.Workbooks.Open("c:\sbda\sbda.xls")
Load FrmInput '将数据输入窗体加载到内存中
Unload frmSplash
Load FrmMain '将主程序界面加载到内存中
End Sub---- 2.报表打印模块
---- 其中ExcelDoForVB1()是一子程序,由prnProess()调用,作用是从Access中提取所需数据资料,填入Excel对应工作表(Worksheet)的相应单元格(Cells)中,然后打印已填入数据的表格;prnProess()则负责实现对VB通用对话框(Commom Dialog)中打印功能的控制。 mdlPrint.bas
Option Explicit
'定义循环计数变量
Public nRow As Integer, nCol As
Integer, nBtoE As Integer
'定义变量接收打印对话框返回值
Public BeginPage, EndPage, NumCopies
'程序运行时需进行判断的各种标志
Public nflag, Flag, ifNum
'数据记录集中指针移动数
Public PageN As Integer, n As Integer
'bar1为进度条
Public bar1 As ObjectSub prnProess()
'控制通用对话框打印功能
Set bar1 = FrmPrint.PgsBar1 '进度条
On Error GoTo errhandle:
If Flag = 0 Then '当打印对话框中选"全部"时
Select Case Opt '选择需要打印的表格
Case 1
nflag = 1
myrecordset1.MoveFirst
myrecordset1.MovePrevious
PageN = 1
Do While nflag = 1
Call ExcelDoForVB1
'数据填入Excel单元格打印
PageN = PageN + 1
Loop
Case 2
……
……
End Select
Else
If Flag = 2 Then '
当打印对话框中选"页"时
If EndPage - BeginPage = 0 Then
ifNum = 0
Else
If EndPage - BeginPage > 0 Then
ifNum = 1
Else
ifNum = 2
End If
End If
Select Case ifNum
Case 2
Exit Sub
Case 0
Select Case Opt '
选择需要打印的表格
Case 1
myrecordset1.MoveFirst
n = (BeginPage - 1) *
(49 - 4 + 1) - 1
myrecordset1.Move n
PageN = BeginPage
Call ExcelDoForVB1
'数据填入Excel单元格并打印
Case 2
……
……
End Select
Case 1
Select Case Opt
'选择需要打印的表格
Case 1
myrecordset1.MoveFirst
n = (BeginPage - 1) *
(49 - 4 + 1) - 1
myrecordset1.Move n
PageN = BeginPage
For nBtoE = BeginPage To EndPage
Call ExcelDoForVB1
'填入Excel单元格并打印
PageN = PageN + 1
Next nBtoE
Case 2
……
……
End Select
End Select
End If
End If
FrmMain.Visible = True
Exit Sub
errhandle:
FrmPrint.Visible = False
FrmMain.Visible = True
End Sub---- 注意,下段仅通过ExcelDoForVB1()对"报表(一)"的处理,来说明数据填入Excel并打印的整个过程。 Sub ExcelDoForVB1() '打印报表(一)
FrmPrint.Visible = True
Set exsheet = exwbook.Worksheets("sheet1")
ex.Sheets("Sheet1").Select
ex.Range("A4:U49").Select
ex.Selection.ClearContents
ex.Range("A4").Select
bar1.Min = 0
bar1.Max = 45
For nRow = 4 To 49
bar1.Value = nRow - 4 '进度显示栏进程
myrecordset1.MoveNext
If myrecordset1.EOF Then
nflag = 0
Exit For
End If
For nCol = 1 To 21
exsheet.Cells(nRow, nCol) =
myrecordset1.Fields(nCol - 1)
Next nCol
Next nRow
exsheet.Cells(52, 21) = "第 " + CStr(PageN) + " 页"
FrmPrint.Visible = False
bar1.Value = 0
ActiveWindow.SelectedSheets.PrintOut Copies:=NumCopies
End Sub---- 虽然本文针对的是大多数已熟练掌握数据库技术,且精通编程之道的朋友们。但笔者认为仍有必要提一提将数据输入Access的过程,因为编出来的软件更多是面向各类普通用户,对他们来说最要紧的是好用,而其间的一系列关联并不想深究。所以设计一个好的输入界面十分有必要,在设计时可以运用VB提供的Data控件,当然若是考虑性能的话还可以用代码直接操纵数据。关于如何使用Data控件访问数据库,在Visual Basic的联机手册(Online book)中有很详细的说明,此处不再赘述。
---- 文中的所有程序在Visual Bsaic5.0中文专业版及Office97中文版中调试通过。
如何將 Excel 的文件导入 Access文件?
下面已将程序代码做成模块,只要导入必要之参数即可!此一模块共有四个参数:
1、sSheetName:要导出资料的文件名称 (Sheet name),例如 Sheet1
2、sExcelPath:要导出资料的 Excel 档案路径名称 (Workbook path),例如 C:\book1.xls
3、sAccessTable:要导入的 Access Table 名称,例如 TestTable
4、sAccessDBPath:要导入的 Access 档案路径名称,例如 C:\Test.mdb在声明中加入以下:Private Sub ExportExcelSheetToAccess(sSheetName As String, _
sExcelPath As String, sAccessTable As String, sAccessDBPath As String)
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(sExcelPath, True, False, "Excel 5.0")
Call db.Execute("Select * into [;database=" & sAccessDBPath & "]." & _
sAccessTable & " FROM [" & sSheetName & "$]")
MsgBox "Table exported successfully.", vbInformation, "Yams"
End Sub
使用范例如下:將 C:\book1.xls 中的 Sheet1 导入 C:\Test.mdb 成为 TestTableExportExcelSheetToAccess "Sheet1", "C:\book1.xls", "TestTable", "C:\Test.mdb"
Option Explicit
Dim Db As Database
Dim Rs As RecordsetPrivate Sub Form_Load()
Set Db = OpenDatabase("c:\temp\book1.xls", False, False, "Excel 8.0;")
Set Rs = Db.OpenRecordset("sheet1$")
End SubPrivate Sub Form_Unload(Cancel As Integer)
Rs.Close
Db.Close
End Sub
http://jszb.jsagri.gov.cn/vb/source/chinese/dbf/d019_xlstomdb.zip
http://support.microsoft.com/support/kb/articles/Q295/6/46.aspHOWTO: Transfer Data from an ADO Recordset to Excel with Automation
http://support.microsoft.com/support/kb/articles/Q246/3/35.ASP