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
5  37137 
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
This looks cool, for a hack like myself can this code be run on my PC or do I need server access.
James
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
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
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
Sign in to post your reply or Sign up for a free account.
Similar topics
by: Ward B |
last post by:
Greetings.
I'm somewhat new to this whole MySQL/PHP thing and need a little help.
My web hosting service uses phpMyAdmin and at the bottom of the screen
iis an area where I can upload a text...
|
by: Pecanfan |
last post by:
Hi,
I'm trying to come up with a way of generating 'warning' e-mails based on
specific criteria within an Access (2003) database. I've decided to do this
by exporting specific information to a...
|
by: Neil |
last post by:
Hi guyz, just trying out this google feature so if i post if in the
wrong area i appologize. now to my question. BTW i'm new to access
programming, i've done a little vb6.0 and vb.net but access...
|
by: raju5725 |
last post by:
I have a MS access table and I want to export it to comma delimited
text file. How do I do this programmatically using VB.NET or C#?
Thanks for any help in advance.
Raju
|
by: raju5725 |
last post by:
have a MS access table and I want to export it to comma delimited
text file. How do I do this programmatically using VB.NET or C#?
Thanks for any help in advance.
Raju
|
by: raju5725 |
last post by:
have a MS access table and I want to export it to comma delimited
text file. How do I do this programmatically using VB.NET?
Thanks for any help in advance.
Raju
|
by: christine0207 |
last post by:
Hi,
how to generate a fixed length data text file using Scripting.TextStream / filesystemobject.
|
by: NEWSGROUPS |
last post by:
I have data in a table in an Access 2000 database that needs to be exported
to a formatted text file. For instance, the first field is an account number
that is formatted in the table as text and...
|
by: Wayne |
last post by:
I'm trying to automate the export of a query to a text file using
code. If I export the query manually I get the exact result that I
want i.e. If I select the query then choose File/Export from...
|
by: Thiem Teddy |
last post by:
Dear all
I use VB6 to export data into xls or text file, I followed this example ( http://bytes.com/topic/visual-basic/answers/530866-how-export-table-data-into-xls-text-file-using-vb6 ). but I...
|
by: taylorcarr |
last post by:
A Canon printer is a smart device known for being advanced, efficient, and reliable. It is designed for home, office, and hybrid workspace use and can also be used for a variety of purposes. However,...
|
by: Charles Arthur |
last post by:
How do i turn on java script on a villaon, callus and itel keypad mobile phone
|
by: aa123db |
last post by:
Variable and constants
Use var or let for variables and const fror constants.
Var foo ='bar';
Let foo ='bar';const baz ='bar';
Functions
function $name$ ($parameters$) {
}
...
|
by: ryjfgjl |
last post by:
If we have dozens or hundreds of excel to import into the database, if we use the excel import function provided by database editors such as navicat, it will be extremely tedious and time-consuming...
|
by: ryjfgjl |
last post by:
In our work, we often receive Excel tables with data in the same format. If we want to analyze these data, it can be difficult to analyze them because the data is spread across multiple Excel files...
|
by: Sonnysonu |
last post by:
This is the data of csv file
1 2 3
1 2 3
1 2 3
1 2 3
2 3
2 3
3
the lengths should be different i have to store the data by column-wise with in the specific length.
suppose the i have to...
|
by: Hystou |
last post by:
There are some requirements for setting up RAID:
1. The motherboard and BIOS support RAID configuration.
2. The motherboard has 2 or more available SATA protocol SSD/HDD slots (including MSATA, M.2...
|
by: Hystou |
last post by:
Most computers default to English, but sometimes we require a different language, especially when relocating. Forgot to request a specific language before your computer shipped? No problem! You can...
|
by: Oralloy |
last post by:
Hello folks,
I am unable to find appropriate documentation on the type promotion of bit-fields when using the generalised comparison operator "<=>".
The problem is that using the GNU compilers,...
| |
