-
Saving data in incremental way in dat format-Help Needed.
Hi to all senior members,
below is the code which saves data in dat format.But the problem is it does not save data in incremental way. It changes only if there is a change in the sheet. Can anyone help me .
Here is the code:
--------------
[VBA] 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), "*")
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
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[/VBA]
Thanks in advance.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules