Visual Basic Programming
 
Forums: » Register « |  User CP |  Games |  Calendar |  Members |  FAQs |  Sitemap |  Support | 
 
User Name:
Password:
Remember me
Go Back   ASP Free Forums > Programming > Visual Basic Programming
Reload this Page

creating a CSV file from Access database table using VB6

Discuss creating a CSV file from Access database table using VB6 in the Visual Basic Programming forum on ASP Free.
creating a CSV file from Access database table using VB6 Visual Basic Programming forum discussing coding strategies, development and techniques. Go from prototype to product quickly using this robust platform.

Record onscreen activity, your voice & webcam video. Turn everyday presentations into HD-quality videos.

For perfectly clear screencasts every time.
Build the right apps the right way with powerful development tools.


Visual Studio 2010. Learn more.
We cover the world of technology like no one else, constantly updating you with the best information available on open source software, Microsoft technologies, hardware and news from around the world.

Try Camtasia Studio today!
www.microsoft.com/visualstudio.com
Sign up today!

Reply
Add This Thread To:
  Del.icio.us   Digg   Google   Spurl   Blink   Furl   Simpy   Y! MyWeb 
« Previous Thread | Next Thread »  
Thread Tools Search this Thread Rate Thread Display Modes
 
Unread ASP Free Forums Sponsor:
  #1  
Old August 11th, 2004, 10:40 AM
Danny20 Danny20 is offline
Registered User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Posts: 13 Danny20 User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
Post creating a CSV file from Access database table using VB6


i have an access file which contain 5 tables , each of these 5 tables contain a number of columns
what am trying to do is , to store the tables of these access files as CSV file using VB6 ( Visual Basic 6)

but am stuck since i didnt get used to use VB6 previously

any suggestions
Reply With Quote
  #2  
Old August 11th, 2004, 04:12 PM
Mythomep Mythomep is offline
Contributing User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Location: Zaandam, The Netherlands
Posts: 70 Mythomep User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: 11 m 37 sec
Reputation Power: 6
Send a message via MSN to Mythomep
Hi,

Bear with me, when I'm at my work, I have code that does just that. Can't recall it from memory though...

Grtz.©

M.
Reply With Quote
  #3  
Old August 12th, 2004, 03:08 AM
Danny20 Danny20 is offline
Registered User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Posts: 13 Danny20 User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
Thanks alot for your help

well, the Lecturer said that i didnt understand the task

i will explain to you ,

we have about 20 strings and we want to create a CSV file

but we want to create as the following

FirstString, 50 space , SecondString, 50 space, THird String, 30 space and so one

The problem is i dont know how to write to a file by doin this
Reply With Quote
  #4  
Old August 12th, 2004, 03:35 AM
Mythomep Mythomep is offline
Contributing User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Location: Zaandam, The Netherlands
Posts: 70 Mythomep User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: 11 m 37 sec
Reputation Power: 6
Send a message via MSN to Mythomep
Hi,

The following code makes opens up a database (put your path there) and then uses a button "cmdExport" to export table names to a CSV file with 50 spaces between the field, spaces(50), field thingie. Don't know what weird requirement you got but it does just that.

Code:
Option Explicit
Private m_cnDatabase As ADODB.Connection
Private Sub cmdExport_Click()
  Call ExportToCVS("Medewerkers")
  Call ExportToCVS("Afdelingen")
End Sub
Private Sub Form_Load()
  Set m_cnDatabase = New ADODB.Connection
  With m_cnDatabase
	.CursorLocation = adUseClient
	.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=G:\Data\Medewerkers\Medewerkers.mdb;"
	.Open
  End With
End Sub
Private Sub ExportToCVS(ByRef sTable As String)
  Dim sExportLine As String
  Dim rsData As ADODB.Recordset
  Dim sSql As String
  Dim hFile As Long
  Dim oField As ADODB.Field
' -----------------------------
  On Error GoTo PROC_ERR
  '
  ' Open the table.
  '
  Set rsData = New ADODB.Recordset
  With rsData
	.ActiveConnection = m_cnDatabase
	.CursorLocation = adUseClient
	.CursorType = adOpenForwardOnly
	.LockType = adLockReadOnly
	
	.Source = "SELECT * FROM " & sTable
	
	.Open
	
	If (.State = adStateOpen) Then
	  hFile = FreeFile
	  Open "C:\Temp\" & sTable & ".CSV" For Output As hFile
	  
	  Do Until .EOF
		sExportLine = ""
		For Each oField In .Fields
		  sExportLine = sExportLine & oField.Value & "," & String(50, Chr$(32)) & ","
		Next
		
		sExportLine = VBA.Left$(sExportLine, Len(sExportLine) - 1)
		
		Print #hFile, sExportLine
		
		.MoveNext
	  Loop
	End If
  End With
PROC_EXIT:
  '
  ' Clean up and exit gracefully.
  '
  If (Not rsData Is Nothing) Then
	With rsData
	  If (.State <> adStateClosed) Then
		.Close
	  End If
	End With
  End If
  
  If (hFile <> 0) Then
	Close hFile
  End If
PROC_ERR:
  Select Case Err.Number
  Case Is <> 0
	MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ExportToCVS of Form frmMain"
	Err.Clear
	Resume PROC_EXIT
  End Select
End Sub


Enjoy.

Grtz.©

M.
Reply With Quote
  #5  
Old August 12th, 2004, 03:53 AM
Danny20 Danny20 is offline
Registered User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Posts: 13 Danny20 User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
this the file
Option Explicit

Dim strClaimRecord, strDataField, strClaimID, strNextTable As String
Dim intCharPos, intFieldLength As Integer '// keep track of where we are in the data file
Dim intTemp As Integer
Dim dateDataField As Date
Dim strDataFileName, strTextFileName As String
Dim dataFileLocation As String
Dim myAppID As String
Dim dblPauseUntil As Double
Dim fs, f, ts, fs1, f1 '// for file system handling

'// these next vars are for capturing a bit of claim info to print out in the event of a problem
Dim driverForename, driverSurname, otherForename, otherSurname, addressStreet, addressTown, accidentDate As String



Private Sub Form_Load()

processData.Caption = "Loosemores : Process RAC data"
'// show a list of the current data files
'Dir1.Path = "U:\rac data imports\data files\"

' //file locations
dataRacIncoming.DatabaseName = "k:\db\rac incoming.mdb"
dataFileLocation = "K:\"

'// initialise directory and file boxes
'// Dir1 is for the dat files
Dir1.Path = dataFileLocation
File1.Path = Dir1.Path
File1.Pattern = "*.dat"
Label2.Caption = File1.ListCount & " files to process"
process.Caption = "process data"

'//Dir2 is for the txt files
Dir2.Path = dataFileLocation
File2.Path = Dir2.Path
File2.Pattern = "*.txt"
Label3.Caption = File2.ListCount & " files to print"

'// highlight 1st entry in each list
If File1.ListCount > 0 Then
File1.ListIndex = 0
Else
MsgBox "No data files to be processed"
End If

If File2.ListCount > 0 Then
File2.ListIndex = 0
End If

End Sub


Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub


Private Sub Dir2_Change()
File2.Path = Dir2.Path
End Sub



'// procedure to print out txt files

Private Sub btnPrint_Click()

Dim x, y As Integer

Set fs1 = CreateObject("Scripting.FileSystemObject")

If File2.ListIndex > -1 Then '// only work if there's a file highlighted

Set f1 = fs1.GetFile(dataFileLocation & File2.FileName)

strTextFileName = dataFileLocation & File2.FileName

'// open notepad, print the txt doc and close
myAppID = Shell("C:\Windows\notepad.exe " & strTextFileName, 1) '// open

SendKeys "%FP", True '// print

dblPauseUntil = CDbl(Now) + (1 / 100000) '// a one second delay to wait for app to print
Do Until CDbl(Now) > dblPauseUntil
DoEvents
Loop

SendKeys "%fx", True '// and close

f1.Delete '// delete the txt file
File2.Refresh
Label3.Caption = File2.ListCount & " files to print"

If File2.ListCount > 0 Then '// reselect the file at head of list
File2.ListIndex = 0
End If

End If


End Sub


Sub readDataFile()
'Dim fs, f, ts '// for file system handling
Const ForReading = 1, ForWriting = 2, ForAppending = 3

Set fs = CreateObject("Scripting.FileSystemObject")

If File1.ListIndex > -1 Then '// only work if there's a file highlighted

'Set f = fs.GetFile("U:\rac data imports\data files\" & File1.FileName)
Set f = fs.GetFile(dataFileLocation & File1.FileName)

'strDataFileName = "U:\rac data imports\data files\" & File1.FileName
strDataFileName = dataFileLocation & File1.FileName

Set ts = f.OpenAsTextStream(ForReading)

'// store contents of datafile on variable
strClaimRecord = ts.Readall

ts.Close

checkBasicDetails
End If

End Sub
Reply With Quote
  #6  
Old August 12th, 2004, 03:54 AM
Danny20 Danny20 is offline
Registered User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Posts: 13 Danny20 User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
Private Sub checkBasicDetails()

'// need to find out if the first two characters are "01" which identifies it as basic details
'// if they ain't then there's a problem with the data file

strDataField = Left$(strClaimRecord, 2)

If strDataField <> "01" Then
MsgBox "problem : this data file is corrupted - please contact SPL"
File1.Refresh

Else '// we're ok
'//open the database
'dataRacIncoming.DatabaseName = "u:\rac data imports\rac incoming.mdb"
'dataRacIncoming.DatabaseName = "g:\access\rac\rac incoming.mdb"

'dataRacIncoming.DatabaseName = "k:\db\rac incoming.mdb"


processBasicDetails '// start processing the data file
End If

End Sub


Private Sub processBasicDetails()

'// procedure to process the basic details section of the data file

dataRacIncoming.RecordSource = "Basic Details" '// attach to the right table
dataRacIncoming.Refresh
dataRacIncoming.Recordset.AddNew '// open the table for a new record

dataRacIncoming.Recordset("record identifier") = "01" '// get the first bit into the table

intCharPos = 3 '// position beyond the Record Identifier (ie "01")
intFieldLength = 8 '// the length of the next field


strDataField = getField(intFieldLength) '// call function to return the datafield

'// the first data field is the Claim ID, and we need to keep this in memory as we will
'// need it for subsequent details, if there are any.
strClaimID = strDataField

'// now we can add the claimID into the table
dataRacIncoming.Recordset("claim ID") = strDataField

'// and put the character position beyond the field
intCharPos = intCharPos + intFieldLength

'// step through the data and get the fields into the DB
intFieldLength = 3
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("user") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("Claim Type Code") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("claim product") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("claim category") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("driver title") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("driver forename") = strDataField
intCharPos = intCharPos + intFieldLength
driverForename = strDataField


intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("driver surname") = strDataField
intCharPos = intCharPos + intFieldLength
driverSurname = strDataField


intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("title") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("forename") = strDataField
intCharPos = intCharPos + intFieldLength
otherForename = strDataField

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("surname") = strDataField
intCharPos = intCharPos + intFieldLength
otherSurname = strDataField

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("street") = strDataField
intCharPos = intCharPos + intFieldLength
addressStreet = strDataField


intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("street2") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("town") = strDataField
intCharPos = intCharPos + intFieldLength
addressTown = strDataField

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("county") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("country") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 8
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("post code") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 5
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("work phone international code") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 5
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("work phone area code") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 16
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("work phone number") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 5
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("home phone international code") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 5
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("home phone area code") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 8
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("home phone number") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 10
strDataField = getField(intFieldLength)
If strDataField <> " " Then
dataRacIncoming.Recordset("accident date") = strDataField
End If
intCharPos = intCharPos + intFieldLength
accidentDate = strDataField

intFieldLength = 5
strDataField = getField(intFieldLength)
If strDataField <> " " Then
dataRacIncoming.Recordset("accident time") = strDataField
End If
intCharPos = intCharPos + intFieldLength

intFieldLength = 64
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("accident street") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("accident area") = strDataField
intCharPos = intCharPos + intFieldLength

'// this next one is the first of the Length identifier fields
intFieldLength = 4
strDataField = getField(intFieldLength)
intCharPos = intCharPos + intFieldLength

intFieldLength = CInt(strDataField) '// got the length of the field now

If intFieldLength > 0 Then
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("accident description") = strDataField
Else
dataRacIncoming.Recordset("accident description") = " "
End If

intCharPos = intCharPos + intFieldLength


'// and the next one is the second...
intFieldLength = 4
strDataField = getField(intFieldLength)
intCharPos = intCharPos + intFieldLength

intFieldLength = CInt(strDataField) '// got the length of the field now

If intFieldLength > 0 Then
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("accident note") = strDataField
Else
dataRacIncoming.Recordset("accident note") = " "
End If

intCharPos = intCharPos + intFieldLength


'// and then back to ordinary fields
intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("RAC member") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("claimant driver") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("insured") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("other vehicles") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("other parties") = strDataField
intCharPos = intCharPos + intFieldLength


intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("vehicle damage") = strDataField
intCharPos = intCharPos + intFieldLength


intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("received estimate") = strDataField
intCharPos = intCharPos + intFieldLength


intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("injury driver") = strDataField
intCharPos = intCharPos + intFieldLength


intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("injury other") = strDataField
intCharPos = intCharPos + intFieldLength


intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("loss of earnings") = strDataField
intCharPos = intCharPos + intFieldLength


intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("vehicle in use") = strDataField
intCharPos = intCharPos + intFieldLength


intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("hire vehicle") = strDataField
intCharPos = intCharPos + intFieldLength


intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("other losses") = strDataField
intCharPos = intCharPos + intFieldLength


intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("witnesses") = strDataField
intCharPos = intCharPos + intFieldLength


intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("police involved") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 1
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("police report") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("police force") = strDataField
intCharPos = intCharPos + intFieldLength

'MsgBox (strDataField)
'// update the table record
dataRacIncoming.Recordset.Update
dataRacIncoming.Refresh

nextJob '// see if there's more data

End Sub
Reply With Quote
  #7  
Old August 12th, 2004, 03:57 AM
Danny20 Danny20 is offline
Registered User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Posts: 13 Danny20 User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
rivate Sub clientsInsuranceDetails()
'// code 04

'// first thing to do is to open the table and write the code and claim i/d

dataRacIncoming.RecordSource = "clients insurance details" '// attach to the right table
dataRacIncoming.Refresh
dataRacIncoming.Recordset.AddNew '// open the table for a new record

dataRacIncoming.Recordset("record identifier") = "04" '// get the first bit into the table
dataRacIncoming.Recordset("claim id") = strClaimID '// get the claim id into the table

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("name") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("street") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("street2") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("town") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("county") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("country") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 8
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("post code") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 40
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("policy number") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("policy type") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 8
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("policy excess") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 30
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("claim reference") = strDataField
intCharPos = intCharPos + intFieldLength


dataRacIncoming.Recordset.Update '// write the data away
dataRacIncoming.Refresh


nextJob '// see if there's more data

End Sub

Private Sub involvedParties()
'// code 05

'// first thing to do is to open the table and write the code and claim i/d

dataRacIncoming.RecordSource = "involved parties" '// attach to the right table
dataRacIncoming.Refresh
dataRacIncoming.Recordset.AddNew '// open the table for a new record

dataRacIncoming.Recordset("record identifier") = "05" '// get the first bit into the table
dataRacIncoming.Recordset("claim id") = strClaimID '// get the claim id into the table

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("involvement") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("title") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("forename") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("suurname") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("street") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("street2") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("town") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("county") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 50
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("country") = strDataField
intCharPos = intCharPos + intFieldLength

intFieldLength = 8
strDataField = getField(intFieldLength)
dataRacIncoming.Recordset("post code") = strDataField
intCharPos = intCharPos + intFieldLength

dataRacIncoming.Recordset.Update '// write the data away
dataRacIncoming.Refresh

nextJob '// see if there's more data

End Sub
Reply With Quote
  #8  
Old August 12th, 2004, 03:58 AM
Danny20 Danny20 is offline
Registered User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Posts: 13 Danny20 User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
Private Sub nextJob()
'// routine to identify the next piece of work to be done on this data

'// find out if there is more data following...
If (intCharPos - 1 = Len(strClaimRecord)) Or (intCharPos - 1 = Len(strClaimRecord) - 2) Then '// there's no more data

File1.Refresh

Dim txtFileName, lengthFileName

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFile(strDataFileName)
lengthFileName = Len(f)

f.Delete '// Delete the dat file.
File1.Refresh

MsgBox "Data processed Ok, and data file cleared"

Label2.Caption = File1.ListCount & " files to process"
Label3.Caption = File2.ListCount & " files to print"


If File1.ListCount > 0 Then
File1.ListIndex = 0
Else
MsgBox "Nowt else to do!"

End If
Label2.Caption = File1.ListCount & " files to process"
Label3.Caption = File2.ListCount & " files to print"

Else '// there is more data

intFieldLength = 2
strNextTable = getField(intFieldLength)
intCharPos = intCharPos + intFieldLength '// put the position beyond the field

Select Case strNextTable

Case "02"
otherInvolvedParties

Case "03"
clientsVehicleDetails

Case "04"
clientsInsuranceDetails

Case "05"
involvedParties

Case Else
fileIsCorrupt
End Select

End If

End Sub


Private Function getField(intFieldLength)
'// function to get a data field out of the file

getField = Mid$(strClaimRecord, intCharPos, intFieldLength)

End Function



Private Sub process_Click()

readDataFile

End Sub

Private Sub fileIsCorrupt()

Dim problemText As String

MsgBox ("Data file " & strDataFileName & " cannot be read. Click OK to Print out problem record...")

Clipboard.SetText (problemText)

myAppID = Shell("C:\Windows\notepad.exe", 1) '// open notepad

SendKeys ("PROBLEM PROBLEM PROBLEM PROBLEM")
SendKeys ("{Enter}")
SendKeys ("{Enter}")
SendKeys ("driver forename : " & driverForename)
SendKeys ("{Enter}")
SendKeys ("driver surname : " & driverSurname)
SendKeys ("{Enter}")
SendKeys ("claimant forename : " & otherForename)
SendKeys ("{Enter}")
SendKeys ("claimant surname : " & otherSurname)
SendKeys ("{Enter}")
SendKeys ("address street : " & addressStreet)
SendKeys ("{Enter}")
SendKeys ("address town : " & addressTown)
SendKeys ("{Enter}")
SendKeys ("accident date : " & accidentDate)
SendKeys ("{Enter}")
SendKeys ("Data File : " & strDataFileName)

SendKeys "%FP", True '// print

dblPauseUntil = CDbl(Now) + (1 / 100000) '// a one second delay to wait for app to print
Do Until CDbl(Now) > dblPauseUntil
DoEvents
Loop

SendKeys "%fx", True '// and close
SendKeys "n", True

f.Delete
File1.Refresh

MsgBox "Problem data printed and data file deleted"

Label2.Caption = File1.ListCount & " files to process"
Label3.Caption = File2.ListCount & " files to print"


End Sub



Private Sub Quit_Click()

End

End Sub
Reply With Quote
  #9  
Old August 12th, 2004, 04:00 AM
Danny20 Danny20 is offline
Registered User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Posts: 13 Danny20 User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
that was the file

basiclly what it does that it takes a DAT file which is flat file which contain alot of text , unorganised one and trying to save

it to a database and it does that perfectly

what i want to do is to run a different procedure which does taking the fields which supposed to be in the database and save

them to a text file and inserting a commas and spaces between them

i know it sound complecated

sorry for botherin u all with me
Reply With Quote
  #10  
Old August 12th, 2004, 04:20 AM
Mythomep Mythomep is offline
Contributing User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Location: Zaandam, The Netherlands
Posts: 70 Mythomep User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: 11 m 37 sec
Reputation Power: 6
Send a message via MSN to Mythomep
Hi,

I must say... holy sh*t. If you ask me, you are sitting on a maintenance nightmare. But, anyway, I modified the code so the first line of the file contains the fieldnames, seperated with a comma.

Code:
Option Explicit
Private m_cnDatabase As ADODB.Connection
Private Sub cmdExport_Click()
  Call ExportToCVS("Medewerkers")
  Call ExportToCVS("Afdelingen")
End Sub
Private Sub Form_Load()
  Set m_cnDatabase = New ADODB.Connection
  With m_cnDatabase
	.CursorLocation = adUseClient
	.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=G:\Data\Medewerkers\Medewerkers.mdb;"
	.Open
  End With
End Sub
Private Sub ExportToCVS(ByRef sTable As String)
  Dim sExportLine As String
  Dim rsData As ADODB.Recordset
  Dim sSql As String
  Dim hFile As Long
  Dim oField As ADODB.Field
' -----------------------------
  On Error GoTo PROC_ERR
  '
  ' Open the table.
  '
  Set rsData = New ADODB.Recordset
  With rsData
	.ActiveConnection = m_cnDatabase
	.CursorLocation = adUseClient
	.CursorType = adOpenForwardOnly
	.LockType = adLockReadOnly
	
	.Source = "SELECT * FROM " & sTable
	
	.Open
	
	If (.State = adStateOpen) Then
	  hFile = FreeFile
	  Open "C:\Temp\" & sTable & ".CSV" For Output As hFile

	  ' Print file header with fieldnames.


	  sExportLine = ""
	  For Each oField In .Fields
		sExportLine = sExportLine & oField.Name & ","
	  Next
	  sExportLine = VBA.Left$(sExportLine, Len(sExportLine) - 1)
	  Print #hFile, sExportLine



   Do Until .EOF
		sExportLine = ""
		For Each oField In .Fields
		  sExportLine = sExportLine & oField.Value & ","
Next
		
		sExportLine = VBA.Left$(sExportLine, Len(sExportLine) - 1)
		
		Print #hFile, sExportLine
		
		.MoveNext
	  Loop
	End If
  End With
PROC_EXIT:
  '
  ' Clean up and exit gracefully.
  '
  If (Not rsData Is Nothing) Then
	With rsData
	  If (.State <> adStateClosed) Then
		.Close
	  End If
	End With
  End If
  
  If (hFile <> 0) Then
	Close hFile
  End If
PROC_ERR:
  Select Case Err.Number
  Case Is <> 0
	MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ExportToCVS of Form frmMain"
	Err.Clear
	Resume PROC_EXIT
  End Select
End Sub
This does exactly what you want. Per table, it exports the fieldnames and the contents in a comma seperated file.
Grtz.©
M.
Reply With Quote
  #11  
Old August 12th, 2004, 08:34 AM
Danny20 Danny20 is offline
Registered User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Posts: 13 Danny20 User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
Thanks alot my friend

but i think you didnt get my problem

just leave the database away

what i want to do is to create a CSV file directly from the Dat file

without going to the tables

thanks
Reply With Quote
  #12  
Old August 12th, 2004, 09:13 AM
Mythomep Mythomep is offline
Contributing User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Location: Zaandam, The Netherlands
Posts: 70 Mythomep User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: 11 m 37 sec
Reputation Power: 6
Send a message via MSN to Mythomep
Hi,

I am not going to repeat all the code, but I will give you a method of doing what you want. You will have to adapt the code to your specific needs.

Code:
Private Sub clientsInsuranceDetails()
'// code 04
  Dim hFile as long
  Dim sExportLine as long
  Dim intFieldLength as integer
  Dim strDataField as string
  Dim intCharPos as integer
  hFile = freefile
  Open "C:\Temp\clientsInsuranceDetails.csv" for output as hFile
  
  ' Write out the header for the file.
  sExportline = "Fieldname1,Fieldname2,Fieldname3"
  Print #hFile, sExportLine
  ' Get all the data from the .dat file and concatenate it to a CSV record.
  sExportLine = sExportLine & strClainID & ","
  
  intFieldLength = 50
  strDataField = getField(intFieldLength)
  sExportLine = sExportLine & strDataField & ","
  intCharPos = intCharPos + intFieldLength
  
  ' Next field until the end of the record.
 
  ' Cut off the last trailing comma and write this to the file.
  sExportLine = Vba.left$(sExportLine, len(sexportline) -1)
  Print #hFile, sExportLine
End sub


Now, this will do what you want. But as you can see, it repeats all the code in the other subs. That makes maintenance a cream. But alas, your app. I sincerly hope that this is what you mean, otherwise I'm dead in the water.

Grtz.©

M.
Reply With Quote
  #13  
Old August 12th, 2004, 09:24 AM
Danny20 Danny20 is offline
Registered User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Posts: 13 Danny20 User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
i know this really annoying for you but i have put your code and it didnt work



what shall i add ...am really sorry for disturbing you but i need to have it done as soon as possible
Reply With Quote
  #14  
Old August 12th, 2004, 10:27 AM
Danny20 Danny20 is offline
Registered User
ASP Free Newbie (0 - 499 posts)
  
Join Date: Aug 2004
Posts: 13 Danny20 User rank is Just a Lowly Private (1 - 20 Reputation Level) 
Time spent in forums: < 1 sec
Reputation Power: 0
Hi my friend , thanks alot for your help

This is smillar to what i was lookin for

http://www.freevbcode.com/ShowCode.Asp?ID=6229

the only point that i need you to help me is " how to store the values which were in the

Dat files to values that i can use to put in the text file"?

like

the first value is 01 or 1....how i can hold the value of this field and to use it to be saved to the

text file
Reply With Quote
Reply

Viewing: ASP Free Forums > Programming > Visual Basic Programming > creating a CSV file from Access database table using VB6

« Previous Thread | Next Thread »

Thread Tools  Search this Thread 
Search this Thread:

Advanced Search
Display Modes  Rate This Thread 
Linear Mode Linear Mode
Rate This Thread:


Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts
vB code is On
Smilies are On
[IMG] code is On
HTML code is Off
View Your Warnings | New Posts | Latest News | Latest Threads | Shoutbox
Forum Jump





 Free IT White Papers!
 
Create the Optimal Architecture for your Critical Applications
Warburton's the largest independently owned bakery in the UK faced a number of difficult challenges in providing the most robust yet efficient IT infrastructure for their organization's success. IBM's services combined with their xSeries servers created the perfect platform for their SAP environment with sufficient flexibility, and did so in very time effective fashion.
 
Five Best Practices for Deploying a Successful Service-Oriented Architecture
This white paper describes the benefits you can expect with SOA, and how IBM can help take your business there.
 
Gartner Magic Quadrant for Application Delivery Controllers
Gartner summarizes its view on Application Delivery Controllers, evaluates strengths and weaknesses of solutions, and provides Magic Quadrant reporting for a quick comparison across all vendors. Learn from Gartner how you can benefit from an all-in-one device like Citrix NetScaler that delivers the highest levels of availability, performance and security.
 
Knowledge is Power
What you don't know can hurt you, and is likely costing you money and increasing your security risks during an era of scarce resources. This white paper proposes six key strategies that enterprise security managers can use to improve their network defense posture.
 
Rationalizing the Multi-Tool Environment
The rationalized multi-tool approach is flexible, scalable and cost effective. It provides the necessary input to the IT service management business processes. It preserves prior investments in monitoring tools, empowers technologists to select the best tools with which to do their jobs, and enhances effective response to incidents.
 

Forums: » Register « |  User CP |  Games |  Calendar |  Members |  FAQs |  Sitemap |  Support | 
  
 





© 2003-2010 by Developer Shed. All rights reserved. DS Cluster 5 Hosted by Hostway. 
For more Enterprise Application Development news, visit eWeek