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

[RadhakrishnanR]

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

[Hemant Pathak]

Sub SaveAsExcel(ByV al rs As DAO.Recordset, ByVal filename
As String, Optional Ffmt As XlFileFormat = xlWorkbookNorma l, _
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.Applicati on
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.MousePoi nter = vbHourglass
' Assign object references to the variables. Use
' Add methods to create new workbook and worksheet
' objects.
Set xlApp = New Excel.Applicati on
Set xlBook = xlApp.Workbooks .Add
Set xlSheet = xlBook.Workshee ts.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).Interi or.ColorIndex = 33
xlSheet.Cells(1 , CellCnt).Font.B old = True
xlSheet.Cells(1 , CellCnt).Border Around 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.Na me).Value
'xlSheet.Column s().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).AutoF it
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 xlWorkbookNorma l, xlExcel2FarEast , xlExcel3, _
xlExcel4, xlExcel4Workboo k, xlExcel5, xlExcel6, _
xlExcel7, xlExcel9795
Fet = "xls"
Case xlHTML
Fet = "htm"
Case xlTextMac, xlTextdos, xlTextWindows, xlUnicodeText, _
xlCurrentPlatfo rmText
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.MousePoi nter = vbDefault
End Sub
''************* ******USAGE BELOW********** *************
Private Sub Command1_Click( )
SaveAsExcel Data1.Recordset .Clone(), Text1.Text, _
Combo1.ItemData (Combo1.ListInd ex)
'End Sub



Private Sub Form_Load()

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

Combo1.ListInde x = 0

End Sub

[kuleszajmk]

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

James

[debuDM]

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

Sub SaveAsExcel(ByV al rs As DAO.Recordset, ByVal filename
As String, Optional Ffmt As XlFileFormat = xlWorkbookNorma l, _
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.Applicati on
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.MousePoi nter = vbHourglass
' Assign object references to the variables. Use
' Add methods to create new workbook and worksheet
' objects.
Set xlApp = New Excel.Applicati on
Set xlBook = xlApp.Workbooks .Add
Set xlSheet = xlBook.Workshee ts.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).Interi or.ColorIndex = 33
xlSheet.Cells(1 , CellCnt).Font.B old = True
xlSheet.Cells(1 , CellCnt).Border Around 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.Na me).Value
'xlSheet.Column s().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).AutoF it
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 xlWorkbookNorma l, xlExcel2FarEast , xlExcel3, _
xlExcel4, xlExcel4Workboo k, xlExcel5, xlExcel6, _
xlExcel7, xlExcel9795
Fet = "xls"
Case xlHTML
Fet = "htm"
Case xlTextMac, xlTextdos, xlTextWindows, xlUnicodeText, _
xlCurrentPlatfo rmText
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.MousePoi nter = vbDefault
End Sub
''************* ******USAGE BELOW********** *************
Private Sub Command1_Click( )
SaveAsExcel Data1.Recordset .Clone(), Text1.Text, _
Combo1.ItemData (Combo1.ListInd ex)
'End Sub



Private Sub Form_Load()

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

Combo1.ListInde x = 0

End Sub

[coolminded]

Sub SaveAsExcel(ByV al rs As DAO.Recordset, ByVal filename
As String, Optional Ffmt As XlFileFormat = xlWorkbookNorma l, _
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.Applicati on
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.MousePoi nter = vbHourglass
' Assign object references to the variables. Use
' Add methods to create new workbook and worksheet
' objects.
Set xlApp = New Excel.Applicati on
Set xlBook = xlApp.Workbooks .Add
Set xlSheet = xlBook.Workshee ts.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).Interi or.ColorIndex = 33
xlSheet.Cells(1 , CellCnt).Font.B old = True
xlSheet.Cells(1 , CellCnt).Border Around 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.Na me).Value
'xlSheet.Column s().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).AutoF it
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 xlWorkbookNorma l, xlExcel2FarEast , xlExcel3, _
xlExcel4, xlExcel4Workboo k, xlExcel5, xlExcel6, _
xlExcel7, xlExcel9795
Fet = "xls"
Case xlHTML
Fet = "htm"
Case xlTextMac, xlTextdos, xlTextWindows, xlUnicodeText, _
xlCurrentPlatfo rmText
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.MousePoi nter = vbDefault
End Sub
''************* ******USAGE BELOW********** *************
Private Sub Command1_Click( )
SaveAsExcel Data1.Recordset .Clone(), Text1.Text, _
Combo1.ItemData (Combo1.ListInd ex)
'End Sub



Private Sub Form_Load()

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

Combo1.ListInde x = 0

End Sub

hi Hemant
can u help my on how to import data from excel to vb
plz, asap

[Thiem Teddy]

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