Question

用vb导出数据到excel文件时，如何生成新的excel文件？

我写的代码只能将数据导出到已经存在的excel文件
我希望：点击导出按钮后，弹出对话框，在文件名里输入我要新保存的文件名，单击保存，可以将生成新的excel文件。

Sub ExportAccessToExcelSheet(sSheetName As String, sExcelPath As String, AccessTable As String, sAccessDBPath As String)
Dim Conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim ExcelApp As New Excel.Application
Dim WorkBookObj As Workbook
Dim SheetObj As Worksheet
Dim i As Integer

Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sAccessDBPath
Conn.Open
rs.Open "Select * From " & AccessTable, Conn, adOpenKeyset, adLockOptimistic, adCmdText
Set WorkBookObj = ExcelApp.Workbooks.Open(sExcelPath)
Set SheetObj = WorkBookObj.Worksheets(1)
For i = 1 To rs.Fields.Count
SheetObj.Cells(1, i) = rs.Fields(i - 1).Name
Next i
SheetObj.Range("A2").CopyFromRecordset rs
SheetObj.Name = sSheetName
Set SheetObj = Nothing
WorkBookObj.Save
WorkBookObj.Close
Set WorkBookObj = Nothing
ExcelApp.Quit
Set ExcelApp = Nothing
rs.Close
Set rs = Nothing
Conn.Close
Set Conn = Nothing
End Sub

Sub exportcmd_Click()
Dim mExcelFile As String
CommonDialog1.Filter = "Excel File|*.xls"
CommonDialog1.ShowSave
mExcelFile = CommonDialog1.FileName
CommonDialog1.FileName = ""
If mExcelFile = "" Then
Exit Sub
Else
ExportAccessToExcelSheet "sheet1", mExcelFile, "fileinfo", App.Path & "\FileManager.mdb"
MsgBox "Data has been exported to Excel file."
End If
Exit Sub
End Sub

Answer 1

抄一段我写的代码给你，除了能新建一个以外，第二个好处是当记录条数超过65535时，它可以自动新增工作表以将全部数据弄进去。你可以根据自己的情况改改。

Public Conn As New ADODB.Connection
Public Rs As New ADODB.Recordset
Public xlApp As New Excel.Application
Public xlWb As New Excel.Workbook
Public xlWs As New Excel.Worksheet

Private Sub mnuQueryExcel_Click()
On Error GoTo ErrHandle
Dim wsSeq As Long, i As Long, Length As Long
xlApp.Visible = True
xlApp.ScreenUpdating = False
DataGrid.Visible = False
Length = Rs.Fields.Count - 1
Call Rs.MoveFirst
Set xlWb = xlApp.Workbooks.Add
wsSeq = 0
Do While Not Rs.EOF
wsSeq = wsSeq + 1
Set xlWs = xlWb.Worksheets.Add
xlWs.Name = "查询结果" & CStr(wsSeq)
For i = 0 To Length
xlWs.Cells(1, i + 1).Value = "'" & Rs.Fields(i).Name
Next i
Call xlWs.Cells(2, 1).CopyFromRecordset(Rs)
Loop
Call Rs.MoveFirst
DataGrid.Visible = True
xlApp.ScreenUpdating = True
Call MsgBox("写入Excel完毕。", vbInformation)
Exit Sub
ErrHandle:
Call MsgBox("错误代码：" & Hex(Err.Number) & vbCrLf & "错误描述：" & Err.Description, vbCritical)
End Sub

Answer 2

在单击事件加入一commondialoge控件，获取输入的文件名，放在变量R中，再把代码中的相应文件名改为R应该可以。

Answer 3

文件名：text1.text
Open App.Path & "\" & text1.Text & ".xls" For Binary As #11
Close #11
加上这句看看。

Answer 4

源程序不是很完整么，保存对话框也有，你想怎么生成新文件？