anilkr99
05-10-2008, 04:38 AM
hi all ,
I am using this code for saving data of my excel sheet in a dat format. The data is saved and if there is a change in the data then it changed in the saved Dat file format. But it is not saved in incrementalway. I need that the data should be saved in incremental way in all the dat file.
Can any body in this forum help me this code workable to my need.
Here is the code:
----------------
Dim fpath As String
Dim spath As String
Dim total_imported_text As String
Dim ilinecount As Long
Dim c
Const ForReading = 1
fpath = "D:\Temp\abdatabase\anil\mstfile.dat"
spath = "D:\Metastock\data1\"
'cmdImport.Enabled = False
If fpath = "" Then
MsgBox fpath & " 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), "*")
'Remove double asterisks @@@@@@@@@@@@@@@@@@@@@@
total_imported_text = Replace(total_imported_text, "**", "*")
'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)
'Start loop at 0 @@@@@@@@@@@@@@@@@@@@@@@@@@
For i = 0 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 & "Data1\" & "TAData" + comma_split(0) & ".dat") = "" Then
Open spath & "TAData" + comma_split(0) & ".dat" For Output As #1
Print #1, 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(Format(Now(), "mm/dd/yyyy"))
dt2 = CDate(Format$(Now(), "hh:mm:ss"))
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 & 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 & 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 & "\Data1\" & "TAData" + comma_split(0) & ".dat" For Output As #1
Print #1, myData1
Close #1
End If
End If
End If
End If
Next i
End If
...............
Thanks in advance
:banghead:
I am using this code for saving data of my excel sheet in a dat format. The data is saved and if there is a change in the data then it changed in the saved Dat file format. But it is not saved in incrementalway. I need that the data should be saved in incremental way in all the dat file.
Can any body in this forum help me this code workable to my need.
Here is the code:
----------------
Dim fpath As String
Dim spath As String
Dim total_imported_text As String
Dim ilinecount As Long
Dim c
Const ForReading = 1
fpath = "D:\Temp\abdatabase\anil\mstfile.dat"
spath = "D:\Metastock\data1\"
'cmdImport.Enabled = False
If fpath = "" Then
MsgBox fpath & " 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), "*")
'Remove double asterisks @@@@@@@@@@@@@@@@@@@@@@
total_imported_text = Replace(total_imported_text, "**", "*")
'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)
'Start loop at 0 @@@@@@@@@@@@@@@@@@@@@@@@@@
For i = 0 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 & "Data1\" & "TAData" + comma_split(0) & ".dat") = "" Then
Open spath & "TAData" + comma_split(0) & ".dat" For Output As #1
Print #1, 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(Format(Now(), "mm/dd/yyyy"))
dt2 = CDate(Format$(Now(), "hh:mm:ss"))
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 & 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 & 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 & "\Data1\" & "TAData" + comma_split(0) & ".dat" For Output As #1
Print #1, myData1
Close #1
End If
End If
End If
End If
Next i
End If
...............
Thanks in advance
:banghead: