Saving data in .dat format-help needed

**anilkr99** · 03-30-2008, 07:35 AM

Here is the code which I am trying to save as .dat format. It reads data from opfile.txt file from a folder and save in another data folder. but the main problem is that if I use common dialog then I have to select again and again for selecting the file and saving the file. But I need automation without common dialog. I am working on the excel sheet on which sheet1 I am receiving data in a10 to i10 and that data is being uploading in opfile.txt . but I am stuck there which is underline in this code. Where I am wrong.Please help.
------------------
[vba]

Sub Importcsv()
Dim fpath As String
Dim spath As String
Const forwriting = 2
fpath = "D:\Temp\Abdatabase\anil\opfile.txt"
spath = "D:\Temp\Abdatabase\anil\Data"
'cmdImport.Enabled = False
If fpath = "" Then
msgbox "opfile does not have data"
Else
Dim fso
Dim act
Dim total_imported_text, total_split_text, total_num_imported
Set fso = CreateObject("scripting.filesystemobject")
'Set act = fso.OpenTextFile("D:\Temp\Abdatabase\anil\opfile.txt")
Set act = fso.OpenTextFile(fpath, forwriting, True) 'me.CommonDialog1.FileName)
total_imported_text = act.readall
--------------------------------
total_imported_text = Replace(total_imported_text, Chr(13), "*")
total_imported_text = Replace(total_imported_text, Chr(10), "*")
'Response.Write total_imported_text
total_imported_text = Replace(total_imported_text, Chr(34), "")
'Remove all the quotes (If your csv has quotes other than to seperate text
'You may want to remove this modifier to the imported text
total_split_text = Split(total_imported_text, "*")
'Split the file up by comma
total_num_imported = UBound(total_split_text)
For i = 1 To total_num_imported - 1 '0 To total_num_imported '
comma_split = Split(total_split_text(i), ",")
On Error Resume Next
If comma_split(0) <> "" Then
Fileld2OfExcel = Trim(Mid(comma_split(0), 2))
'****************Existing Condition*******************************
'Check the column of the excel sheets if it is empty
'if not then print then Row
'****************As per Your Condition*******************************
'A new text file will be created for each row with the text file name as the first column
If Fileld2OfExcel <> "" Then
'****************************************************
'Debug.Print total_split_text(i)
'****************************************************
'Save Each Next Row that is Found
If dir(app.path & "\Data\" & comma_split(0) & ".dat") = "" Then
Open Dname & comma_split(0) & ".dat" For Output As #1
Print #1, Format$(Now(), "mm/dd/yy") & "," & comma_split(2) & "," & comma_split(3) & "," & comma_split(4) _
& "," & comma_split(5) & "," & comma_split(6) & "," & comma_split(7) 'Mid(total_split_text(i), 2) & vbCrLf
Close #1
Else
L_B_Found = False
Less_D_Found = False
Dim myData As String
Dim dt1 As Date
Dim dt2 As Date
myData = ""
myData1 = ""
Open app.path & "\Data\" & comma_split(0) & ".dat" For Input As #1
Do While Not EOF(1)
Line Input #1, myData
If myData <> "" Then
txt = Split(myData, ",")
dt1 = CDate(comma_split(2))
dt2 = CDate(Format$(Now(), "mm/dd/yy"))
If dt1 = dt2 Then
L_B_Found = True
myData1 = myData1 & myData & vbCrLf
ElseIf dt1 < dt2 Then
If Less_D_Found = False Then
Less_D_Found = True
myData1 = myData1 & Format$(Now(), "mm/dd/yy") & "," & comma_split(2) & "," & comma_split(3) & "," & comma_split(4) _
& "," & comma_split(5) & "," & comma_split(6) & "," & comma_split(7) & vbCrLf & myData & vbCrLf
Else
L_B_Found = False
myData1 = myData1 & myData & vbCrLf
End If
Else
myData1 = myData1 & myData & vbCrLf & Format$(Now(), "mm/dd/yy") & "," & comma_split(2) & "," & comma_split(3) & "," & comma_split(4) _
& "," & comma_split(5) & "," & comma_split(6) & "," & comma_split(7) & vbCrLf
End If
End If
Loop
Close #1
If L_B_Found = False Then
Open app.path & "\Data\" & comma_split(0) & ".dat" For Output As #1
Print #1, myData1
Close #1
End If
End If
End If
End If
Next i
'Label1.Caption = "Recently Converted File : " & 'Me.CommonDialog1.FileTitle
MsgBox "File Imported"
End If
End Sub
[/vba]

**mdmackillop** · 03-31-2008, 03:08 PM

Hi Anilkr,
Welcome to VBAX
Can you post a small sample text file to test your code?
Use Manage Attachments in the Go Advanced section
Regards
MD

**anilkr99** · 04-01-2008, 12:18 AM

Dear MD
I am enclosing the txt file in the sourcefolder for your kind perusal. I am having this txtfile in myapplication as "D:\Temp\abdatabase\andy\mst.txt" and I am trying to export the data in the another folder i.e "D:\temp\abdatabase\andy\data" in the format as given in the datafolder using vba. After transfering data a progressbar indication is appreciated insteadof msgbox.
Thanx a lot if this query is solved.

**anilkr99** · 04-01-2008, 01:46 AM

Earlier I used to put Dname the path of the mst.txt file. Sorry I could'nt put the right path name. Please assume it the path of the mst.txt file.

**anilkr99** · 04-01-2008, 02:05 AM

Thanx a lot MD , you have solved my problem . I got where was my mistake. Now I am able to get the data. How can I appreciate this forum. I can't express in my words.
Thanks once again.

**anilkr99** · 04-01-2008, 02:14 AM

Well the data is there in datafolder but the data is not coming in the incremental way ????.here again i am placing this code..

Sub Importcsv()
Dim fpath As String
Dim spath As String
Dim total_imported_text As String
Const forwriting = 2
fpath = "D:\temp\abdatabase\anil\mstfile.txt"
spath = "d:\temp\abdatabase\anil\data\"
'cmdImport.Enabled = False
If fpath = "" Then
MsgBox "opfile does not have data"
Else
Dim fso
Dim act
Dim total_split_text, total_num_imported
Set fso = CreateObject("scripting.filesystemobject")
'Set act = fso.OpenTextFile("D:\Temp\Abdatabase\anil\opfile.txt")
Set act = fso.OpenTextFile(fpath, 1, True) 'me.CommonDialog1.FileName)
total_imported_text = act.readall
'--------------------------------
total_imported_text = Replace(total_imported_text, Chr(13), "*")
total_imported_text = Replace(total_imported_text, Chr(10), "*")
'Response.Write total_imported_text
total_imported_text = Replace(total_imported_text, Chr(34), "")
'Remove all the quotes (If your csv has quotes other than to seperate text
'You may want to remove this modifier to the imported text
total_split_text = Split(total_imported_text, "*")
'Split the file up by comma
total_num_imported = UBound(total_split_text)
For i = 1 To total_num_imported - 1 '0 To total_num_imported '
comma_split = Split(total_split_text(i), ",")
On Error Resume Next
If comma_split(0) <> "" Then
Debug.Print Fileld2OfExcel
Fileld2OfExcel = Trim(Mid(comma_split(0), 2))
'****************Existing Condition*******************************
'Check the column of the excel sheets if it is empty
'if not then print then Row
'****************As per Your Condition*******************************
'A new text file will be created for each row with the text file name as the first column
If Fileld2OfExcel <> "" Then
'****************************************************
'Debug.Print total_split_text(i)
'****************************************************
'Save Each Next Row that is Found
If Dir(spath & "Data\" & comma_split(0) & ".dat") = "" Then
'What is Dname????????????????????????????????????????????????????
Open spath & comma_split(0) & ".dat" For Output As #1
Print #1, Format$(Now(), "mm/dd/yy") & "," & comma_split(2) & "," & comma_split(3) & "," & comma_split(4) _
& "," & comma_split(5) & "," & comma_split(6) & "," & comma_split(7) 'Mid(total_split_text(i), 2) & vbCrLf
Close #1
Else
L_B_Found = False
Less_D_Found = False
Dim myData As String
Dim dt1 As Date
Dim dt2 As Date
myData = ""
myData1 = ""
Open fpath & "\Data\" & comma_split(0) & ".dat" For Input As #1
Do While Not EOF(1)
Line Input #1, myData
If myData <> "" Then
txt = Split(myData, ",")
dt1 = CDate(comma_split(2))
dt2 = CDate(Format$(Now(), "mm/dd/yy"))
If dt1 = dt2 Then
L_B_Found = True
myData1 = myData1 & myData & vbCrLf
ElseIf dt1 < dt2 Then
If Less_D_Found = False Then
Less_D_Found = True
myData1 = myData1 & Format$(Now(), "mm/dd/yy") & "," & comma_split(2) & "," & comma_split(3) & "," & comma_split(4) _
& "," & comma_split(5) & "," & comma_split(6) & "," & comma_split(7) & vbCrLf & myData & vbCrLf
Else
L_B_Found = False
myData1 = myData1 & myData & vbCrLf
End If
Else
myData1 = myData1 & myData & vbCrLf & Format$(Now(), "mm/dd/yy") & "," & comma_split(2) & "," & comma_split(3) & "," & comma_split(4) _
& "," & comma_split(5) & "," & comma_split(6) & "," & comma_split(7) & vbCrLf
End If
End If
Loop
Close #1
If L_B_Found = False Then
Open spath & "\Data\" & comma_split(0) & ".dat" For Output As #1
Print #1, myData1
Close #1
End If
End If
End If
End If
Next i
'Label1.Caption = "Recently Converted File : " & 'Me.CommonDialog1.FileTitle
'MsgBox "File Imported"
End If
End Sub

**anilkr99** · 04-01-2008, 09:08 PM

Thanx for your great support and effort. I have tried the data is coming in the C:\aaa\data. But I noticed that the data which came earlier is deleted and replaced by new data in place of the earlier data.What I need that the data which came earlier say at 1200 hrs must be saved and the data came at 1210 hrs must came in the next row. So I need to save each row in incremental way. example:
04/01/08 ,1000, 110,109,102,110,214567
04/01/08, 1030,110,109,102,112,214890
but in the datafolder I noticed that the data of the first row is replaced by the next row. Can it possible to save all comin data ?
Thanxs for your valuable time to solve this problem.

Thread: Saving data in .dat format-help needed

Thread Tools

Display

Saving data in .dat format-help needed

attachment txt file

Posting Permissions