mdb转化为xls？？

[Samurai]

Dim conTemp As New ADODB.Connection
Dim strSql As String

strSql = "SELECT * INTO [Excel 8.0;DATABASE=F:\VB\工资\MoneyOld.XLS],[基本表] FROM [基本表]"
conTemp.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=F:\VB\工资\MoneyOld.mdb"
conTemp.Open
conTemp.Execute strSql

可系统提示：查询输入必须包含至少一个表或查询？？

[studentcom]

[基本表] FROM [基本表]---第一个不对啦..应该是其他的表名称！

[sonicdater]

'这是我的 把 XLS 转化 为 MDB 的例子。(不是 MDB to XLS)
'希望 对你有帮助 .
'===============================================
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmExcelToMdb
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
Caption = "Excel To MDB Conversion"
ClientHeight = 4305
ClientLeft = 45
ClientTop = 330
ClientWidth = 5475
Icon = "ExcelTOMDB.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4305
ScaleWidth = 5475
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton cmdClose
BackColor = &H0080C0FF&
Caption = "Close"
Height = 360
Left = 3555
Style = 1 'Graphical
TabIndex = 6
Top = 2190
Width = 1530
End
Begin VB.CommandButton cmdAbout
BackColor = &H0080C0FF&
Caption = "About the Author"
Height = 360
Left = 330
Style = 1 'Graphical
TabIndex = 5
Top = 2205
Width = 1530
End
Begin VB.TextBox txtAbout
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1575
Left = 345
MultiLine = -1 'True
TabIndex = 4
Top = 2655
Width = 4770
End
Begin VB.Frame Frame1
BackColor = &H00E0E0E0&
Height = 1455
Left = 345
TabIndex = 1
Top = 675
Width = 4755
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 345
Left = 105
TabIndex = 3
Top = 1035
Visible = 0 'False
Width = 4560
_ExtentX = 8043
_ExtentY = 609
_Version = 393216
BorderStyle = 1
Appearance = 1
End
Begin VB.Label lblStatus
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 810
Left = 105
TabIndex = 2
Top = 255
Width = 4575
End
End
Begin VB.CommandButton cmdConvert
BackColor = &H00FFC0C0&
Caption = "Click Here to Convert an Excel Sheet to an MDB File"
Height = 480
Left = 345
Style = 1 'Graphical
TabIndex = 0
Top = 120
Width = 4740
End
End
Attribute VB_Name = "frmExcelToMdb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub cmdClose_Click()
Unload Me
End Sub

'----------------------------------------------------------------------------------------
' File Name: frmExcelToMdb.frm
'
' Description: This file will convert an Excel Sheet to an MDB File
' Required Softwares :VB6, Excel, Access
'
'----------------------------------------------------------------------------------------
Private Sub CmdConvert_Click()
'Calling procedure to Create the Database
Call CreateAccessDatabase
Screen.MousePointer = vbHourglass
'Calling Procedure to Create table an dInsert the Values
Call CreateAndInsertIntoTable
Screen.MousePointer = vbNormal
End Sub
'----------------------------------------------------------------------------------------
' Function Name: CreateAccessDatabase()
'
' Description: This will Create an Access Database
'----------------------------------------------------------------------------------------
Sub CreateAccessDatabase()
On Error GoTo err1

Dim catNewDB As ADOX.Catalog 'Catalog Object

Set catNewDB = New ADOX.Catalog

'Creating Database
catNewDB.Create "Provider=Microsoft.Jet.OLEDB.3.51;" & _
"Data Source=" & App.Path & "\Test.MDB"
Set catNewDB = Nothing
Exit Sub
err1:
'If MDB Already exists then does nothing
If Err.Number = -2147217897 Then
Exit Sub
End If
End Sub
'----------------------------------------------------------------------------------------
' Function Name: CreateAndInsertIntoTable()
'
' Description: This will Create a table and will insert values to the Test Table
'----------------------------------------------------------------------------------------
Sub CreateAndInsertIntoTable()

Dim tbl As New Table
Dim cat As New ADOX.Catalog
Dim cn As New ADODB.Connection
Dim rec As New ADODB.Recordset
Dim fld As ADODB.Field
Dim recNew As New ADODB.Recordset
Dim strExcelPath As String
Dim intcnt As Long

'Excel File Path
strExcelPath = App.Path & "\Book1.xls"

'Opening Catalog Connection
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
"Data Source=" & App.Path & "\Test.MDB"

'Opening Excel Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source= " & strExcelPath & ";Extended Properties=Excel 8.0;" _
& "Persist Security Info=False"

'Opening Sheet in Excel Sheet Like a Table
rec.Open "Select * from [Sheet1$]", cn, adOpenKeyset

'To delete If "Test" Table is already there
If cat.Tables.Count <> 4 Then cat.Tables.Delete "Test"
'------------------------------------------------------------------------------------
'Creating Table
'------------------------------------------------------------------------------------
'Assigning Table Name
tbl.Name = "Test"
'Appending Column-The Col Name will be the Column name from the Sheet
For Each fld In rec.Fields
tbl.Columns.Append fld.Name, adChar, 200
Next
'Creating Table using Catalog Object of ADOX
cat.Tables.Append tbl
'Opening the Newly created table in Test.MDB
recNew.Open "Test", cat.ActiveConnection, adOpenKeyset, adLockOptimistic
'Making Pg Bar Visible
ProgressBar1.Visible = True
'Setting Max value of Pg BAr as No of Records in the Sheet
If rec.RecordCount <> 0 Then
ProgressBar1.Max = rec.RecordCount
End If
'Initialising Counter
intcnt = 1
Do Until rec.EOF
'Calling DoEvents so as to see the counter correctly
DoEvents
With recNew
.AddNew
For Each fld In rec.Fields
'Assigning value to the recNew Recordset for Insertion
.Fields(fld.Name) = IIf(IsNull(rec(fld.Name)), "", rec(fld.Name))
Next
.Update
End With
'Assigning Value to PgBar Control
ProgressBar1.Value = intcnt
'Assigning Value to Label Control
lblStatus.Caption = "Added " & intcnt & " Records..."
'Incrementing Counter
intcnt = intcnt + 1
'Moving to Next Record
rec.MoveNext
Loop
DoEvents
'Showing the Location of MDB File
lblStatus.Caption = "Open the MDB File at " & App.Path & "\Test.Mdb"
ProgressBar1.Visible = False
End Sub
Private Sub Form_Load()
Me.Height = 3015
End Sub

[jett]

收藏