By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
440,640 Members | 1,581 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 440,640 IT Pros & Developers. It's quick & easy.

How to export table data into xls or text file using VB6

P: 15
Hi,


By using VB6.0, I want to export database table data into (i.e based on the selected file type(xls or txt)) excel file or text file with a tab delimited text file.

My User interface has:

Drop down list box contain list of data base table name.
A path selection area, allowing the user to specify the filename, path and file type for the
export. This will incorporate standard Windows functionality for allowing the user to specify
file type such as tab delimited text or Excel. The path will default to the xyz server upon
which my project instance is running but will allow the user to navigate to any other mapped drive.

Export button when clicked, this activates the data export using the parameters provided.

I think i have to use common dialog box as well. I am new to this job..please give me relevant code...

Thanks in advance
Radhakrishnan
vrradhakrishnan@gmail.com
Sep 2 '06 #1
Share this Question
Share on Google+
5 Replies


Expert
P: 92
Sub SaveAsExcel(ByVal rs As DAO.Recordset, ByVal filename
As String, Optional Ffmt As XlFileFormat = xlWorkbookNormal, _
Optional bHeaders As Boolean = True)
'************************************************* **********
' Marko Hernandez
' Dec. 2, 2000
'
' Exports a Recordset data into a Microsoft Excel Sheet and
'then can save as new file
' with a given format such Lotus, Q-Pro, dBase, Text
'
' Arguments:
'
' rs : Recordset object (DAO) containing data.
' filename: Name of the file.
' Ffmt: File Format the default value is the
'MS-Excel current version.
' bHeaders: If true the name of the fields will be inserted
'in the first row of each column.
'

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

'Field object
Dim fd As Field

'Cell count, the cells we can use
Dim CellCnt As Integer

'File Extension Type
Dim Fet As String

Screen.MousePointer = vbHourglass
' Assign object references to the variables. Use
' Add methods to create new workbook and worksheet
' objects.
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add

'Get the field names
If bHeaders Then
CellCnt = 1
For Each fd In rs.Fields
Select Case fd.Type
Case dbBinary, dbGUID, dbLongBinary, dbVarBinary
' This type of data can't export to excel
Case Else
xlSheet.Cells(1, CellCnt).Value = fd.Name
xlSheet.Cells(1, CellCnt).Interior.ColorIndex = 33
xlSheet.Cells(1, CellCnt).Font.Bold = True
xlSheet.Cells(1, CellCnt).BorderAround xlContinuous
CellCnt = CellCnt + 1
End Select
Next
End If

'Rewind the rescordset
rs.MoveFirst
i = 2
Do While Not rs.EOF()
CellCnt = 1
For Each fd In rs.Fields
Select Case fd.Type
Case dbBinary, dbGUID, dbLongBinary, dbVarBinary
' This type of data can't export to excel
Case Else
xlSheet.Cells(i, CellCnt).Value = _
rs.Fields(fd.Name).Value
'xlSheet.Columns().AutoFit
CellCnt = CellCnt + 1
End Select
Next
rs.MoveNext
i = i + 1
Loop

'Fit all columns
CellCnt = 1
For Each fd In rs.Fields

Select Case fd.Type
Case dbBinary, dbGUID, dbLongBinary, _
dbVarBinary
' This type of data can't export to excel
Case Else
xlSheet.Columns(CellCnt).AutoFit
CellCnt = CellCnt + 1
End Select
Next

'Get the file extension
Select Case Ffmt
Case xlSYLK
Fet = "slk"
Case xlWKS
Fet = "wks"
Case xlWK1, xlWK1ALL, xlWK1FMT
Fet = "wk1"
Case xlCSV, xlCSVMac, xlCSVdos, xlCSVWindows
Fet = "csv"
Case xlDBF2, xlDBF3, xlDBF4
Fet = "dbf"
Case xlWorkbookNormal, xlExcel2FarEast, xlExcel3, _
xlExcel4, xlExcel4Workbook, xlExcel5, xlExcel6, _
xlExcel7, xlExcel9795
Fet = "xls"
Case xlHTML
Fet = "htm"
Case xlTextMac, xlTextdos, xlTextWindows, xlUnicodeText, _
xlCurrentPlatformText
Fet = "txt"
Case xlTextPrinter
Fet = "prn"
Case Else
Fet = "dat"
End Select

' Save the Worksheet.
If InStr(1, filename, ".") = 0 Then filename = _
filename + "." + Fet
xlSheet.SaveAs filename, Ffmt

' Close the Workbook
xlBook.Close
' Close Microsoft Excel with the Quit method.
xlApp.Quit

' Release the objects.
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

Screen.MousePointer = vbDefault
End Sub
''*******************USAGE BELOW***********************
Private Sub Command1_Click()
SaveAsExcel Data1.Recordset.Clone(), Text1.Text, _
Combo1.ItemData(Combo1.ListIndex)
'End Sub



Private Sub Form_Load()

Text1.Text = "C:\Export"
Combo1.AddItem "Installed Excel Format"
Combo1.ItemData(Combo1.NewIndex) = xlWorkbookNormal
Combo1.AddItem "Comma Separated Text"
Combo1.ItemData(Combo1.NewIndex) = xlCSV
Combo1.AddItem "Excel 95/97"
Combo1.ItemData(Combo1.NewIndex) = xlExcel9795
Combo1.AddItem "Internet Format (HTML)"
Combo1.ItemData(Combo1.NewIndex) = xlHtml
Combo1.AddItem "MS-DOS Text"
Combo1.ItemData(Combo1.NewIndex) = xlTextMSDOS
Combo1.AddItem "Lotus 123 (WK1)"
Combo1.ItemData(Combo1.NewIndex) = xlWK1
Combo1.AddItem "Lotus 123 (WKS)"
Combo1.ItemData(Combo1.NewIndex) = xlWKS
Combo1.AddItem "Quattro Pro"
Combo1.ItemData(Combo1.NewIndex) = xlWQ1

Combo1.ListIndex = 0

End Sub
Sep 5 '06 #2

P: 1
This looks cool, for a hack like myself can this code be run on my PC or do I need server access.

James
Nov 11 '06 #3

P: 1
the following code is not running higher version of office software.

Sub SaveAsExcel(ByVal rs As DAO.Recordset, ByVal filename
As String, Optional Ffmt As XlFileFormat = xlWorkbookNormal, _
Optional bHeaders As Boolean = True)
'************************************************* **********
' Marko Hernandez
' Dec. 2, 2000
'
' Exports a Recordset data into a Microsoft Excel Sheet and
'then can save as new file
' with a given format such Lotus, Q-Pro, dBase, Text
'
' Arguments:
'
' rs : Recordset object (DAO) containing data.
' filename: Name of the file.
' Ffmt: File Format the default value is the
'MS-Excel current version.
' bHeaders: If true the name of the fields will be inserted
'in the first row of each column.
'

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

'Field object
Dim fd As Field

'Cell count, the cells we can use
Dim CellCnt As Integer

'File Extension Type
Dim Fet As String

Screen.MousePointer = vbHourglass
' Assign object references to the variables. Use
' Add methods to create new workbook and worksheet
' objects.
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add

'Get the field names
If bHeaders Then
CellCnt = 1
For Each fd In rs.Fields
Select Case fd.Type
Case dbBinary, dbGUID, dbLongBinary, dbVarBinary
' This type of data can't export to excel
Case Else
xlSheet.Cells(1, CellCnt).Value = fd.Name
xlSheet.Cells(1, CellCnt).Interior.ColorIndex = 33
xlSheet.Cells(1, CellCnt).Font.Bold = True
xlSheet.Cells(1, CellCnt).BorderAround xlContinuous
CellCnt = CellCnt + 1
End Select
Next
End If

'Rewind the rescordset
rs.MoveFirst
i = 2
Do While Not rs.EOF()
CellCnt = 1
For Each fd In rs.Fields
Select Case fd.Type
Case dbBinary, dbGUID, dbLongBinary, dbVarBinary
' This type of data can't export to excel
Case Else
xlSheet.Cells(i, CellCnt).Value = _
rs.Fields(fd.Name).Value
'xlSheet.Columns().AutoFit
CellCnt = CellCnt + 1
End Select
Next
rs.MoveNext
i = i + 1
Loop

'Fit all columns
CellCnt = 1
For Each fd In rs.Fields

Select Case fd.Type
Case dbBinary, dbGUID, dbLongBinary, _
dbVarBinary
' This type of data can't export to excel
Case Else
xlSheet.Columns(CellCnt).AutoFit
CellCnt = CellCnt + 1
End Select
Next

'Get the file extension
Select Case Ffmt
Case xlSYLK
Fet = "slk"
Case xlWKS
Fet = "wks"
Case xlWK1, xlWK1ALL, xlWK1FMT
Fet = "wk1"
Case xlCSV, xlCSVMac, xlCSVdos, xlCSVWindows
Fet = "csv"
Case xlDBF2, xlDBF3, xlDBF4
Fet = "dbf"
Case xlWorkbookNormal, xlExcel2FarEast, xlExcel3, _
xlExcel4, xlExcel4Workbook, xlExcel5, xlExcel6, _
xlExcel7, xlExcel9795
Fet = "xls"
Case xlHTML
Fet = "htm"
Case xlTextMac, xlTextdos, xlTextWindows, xlUnicodeText, _
xlCurrentPlatformText
Fet = "txt"
Case xlTextPrinter
Fet = "prn"
Case Else
Fet = "dat"
End Select

' Save the Worksheet.
If InStr(1, filename, ".") = 0 Then filename = _
filename + "." + Fet
xlSheet.SaveAs filename, Ffmt

' Close the Workbook
xlBook.Close
' Close Microsoft Excel with the Quit method.
xlApp.Quit

' Release the objects.
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

Screen.MousePointer = vbDefault
End Sub
''*******************USAGE BELOW***********************
Private Sub Command1_Click()
SaveAsExcel Data1.Recordset.Clone(), Text1.Text, _
Combo1.ItemData(Combo1.ListIndex)
'End Sub



Private Sub Form_Load()

Text1.Text = "C:\Export"
Combo1.AddItem "Installed Excel Format"
Combo1.ItemData(Combo1.NewIndex) = xlWorkbookNormal
Combo1.AddItem "Comma Separated Text"
Combo1.ItemData(Combo1.NewIndex) = xlCSV
Combo1.AddItem "Excel 95/97"
Combo1.ItemData(Combo1.NewIndex) = xlExcel9795
Combo1.AddItem "Internet Format (HTML)"
Combo1.ItemData(Combo1.NewIndex) = xlHtml
Combo1.AddItem "MS-DOS Text"
Combo1.ItemData(Combo1.NewIndex) = xlTextMSDOS
Combo1.AddItem "Lotus 123 (WK1)"
Combo1.ItemData(Combo1.NewIndex) = xlWK1
Combo1.AddItem "Lotus 123 (WKS)"
Combo1.ItemData(Combo1.NewIndex) = xlWKS
Combo1.AddItem "Quattro Pro"
Combo1.ItemData(Combo1.NewIndex) = xlWQ1

Combo1.ListIndex = 0

End Sub
Apr 25 '07 #4

100+
P: 138
Sub SaveAsExcel(ByVal rs As DAO.Recordset, ByVal filename
As String, Optional Ffmt As XlFileFormat = xlWorkbookNormal, _
Optional bHeaders As Boolean = True)
'************************************************* **********
' Marko Hernandez
' Dec. 2, 2000
'
' Exports a Recordset data into a Microsoft Excel Sheet and
'then can save as new file
' with a given format such Lotus, Q-Pro, dBase, Text
'
' Arguments:
'
' rs : Recordset object (DAO) containing data.
' filename: Name of the file.
' Ffmt: File Format the default value is the
'MS-Excel current version.
' bHeaders: If true the name of the fields will be inserted
'in the first row of each column.
'

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

'Field object
Dim fd As Field

'Cell count, the cells we can use
Dim CellCnt As Integer

'File Extension Type
Dim Fet As String

Screen.MousePointer = vbHourglass
' Assign object references to the variables. Use
' Add methods to create new workbook and worksheet
' objects.
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add

'Get the field names
If bHeaders Then
CellCnt = 1
For Each fd In rs.Fields
Select Case fd.Type
Case dbBinary, dbGUID, dbLongBinary, dbVarBinary
' This type of data can't export to excel
Case Else
xlSheet.Cells(1, CellCnt).Value = fd.Name
xlSheet.Cells(1, CellCnt).Interior.ColorIndex = 33
xlSheet.Cells(1, CellCnt).Font.Bold = True
xlSheet.Cells(1, CellCnt).BorderAround xlContinuous
CellCnt = CellCnt + 1
End Select
Next
End If

'Rewind the rescordset
rs.MoveFirst
i = 2
Do While Not rs.EOF()
CellCnt = 1
For Each fd In rs.Fields
Select Case fd.Type
Case dbBinary, dbGUID, dbLongBinary, dbVarBinary
' This type of data can't export to excel
Case Else
xlSheet.Cells(i, CellCnt).Value = _
rs.Fields(fd.Name).Value
'xlSheet.Columns().AutoFit
CellCnt = CellCnt + 1
End Select
Next
rs.MoveNext
i = i + 1
Loop

'Fit all columns
CellCnt = 1
For Each fd In rs.Fields

Select Case fd.Type
Case dbBinary, dbGUID, dbLongBinary, _
dbVarBinary
' This type of data can't export to excel
Case Else
xlSheet.Columns(CellCnt).AutoFit
CellCnt = CellCnt + 1
End Select
Next

'Get the file extension
Select Case Ffmt
Case xlSYLK
Fet = "slk"
Case xlWKS
Fet = "wks"
Case xlWK1, xlWK1ALL, xlWK1FMT
Fet = "wk1"
Case xlCSV, xlCSVMac, xlCSVdos, xlCSVWindows
Fet = "csv"
Case xlDBF2, xlDBF3, xlDBF4
Fet = "dbf"
Case xlWorkbookNormal, xlExcel2FarEast, xlExcel3, _
xlExcel4, xlExcel4Workbook, xlExcel5, xlExcel6, _
xlExcel7, xlExcel9795
Fet = "xls"
Case xlHTML
Fet = "htm"
Case xlTextMac, xlTextdos, xlTextWindows, xlUnicodeText, _
xlCurrentPlatformText
Fet = "txt"
Case xlTextPrinter
Fet = "prn"
Case Else
Fet = "dat"
End Select

' Save the Worksheet.
If InStr(1, filename, ".") = 0 Then filename = _
filename + "." + Fet
xlSheet.SaveAs filename, Ffmt

' Close the Workbook
xlBook.Close
' Close Microsoft Excel with the Quit method.
xlApp.Quit

' Release the objects.
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

Screen.MousePointer = vbDefault
End Sub
''*******************USAGE BELOW***********************
Private Sub Command1_Click()
SaveAsExcel Data1.Recordset.Clone(), Text1.Text, _
Combo1.ItemData(Combo1.ListIndex)
'End Sub



Private Sub Form_Load()

Text1.Text = "C:\Export"
Combo1.AddItem "Installed Excel Format"
Combo1.ItemData(Combo1.NewIndex) = xlWorkbookNormal
Combo1.AddItem "Comma Separated Text"
Combo1.ItemData(Combo1.NewIndex) = xlCSV
Combo1.AddItem "Excel 95/97"
Combo1.ItemData(Combo1.NewIndex) = xlExcel9795
Combo1.AddItem "Internet Format (HTML)"
Combo1.ItemData(Combo1.NewIndex) = xlHtml
Combo1.AddItem "MS-DOS Text"
Combo1.ItemData(Combo1.NewIndex) = xlTextMSDOS
Combo1.AddItem "Lotus 123 (WK1)"
Combo1.ItemData(Combo1.NewIndex) = xlWK1
Combo1.AddItem "Lotus 123 (WKS)"
Combo1.ItemData(Combo1.NewIndex) = xlWKS
Combo1.AddItem "Quattro Pro"
Combo1.ItemData(Combo1.NewIndex) = xlWQ1

Combo1.ListIndex = 0

End Sub

hi Hemant
can u help my on how to import data from excel to vb
plz, asap
Apr 27 '07 #5

P: 2
Dear Hemant Pathak
I tried to execute your program but i don't know what kind of libraries that i need to add into your program. pls you tell me how many libraries and waht kind of libraries i have to add in?

because i am a new in VB6
thanks for your contribution
Mar 30 '11 #6

Post your reply

Sign in to post your reply or Sign up for a free account.