Sub Content_for_etfs_convert()
Kill "D:\option programs\отбор\IN\*.*"
Kill "D:\option programs\отбор\OUT\*.*"
Dim fso
Set fso = CreateObject("scripting.filesystemobject"): fso.CopyFolder "C:\Users\Администратор\Downloads\Stock\src\dist\downloads", "D:\option programs\отбор\IN"
Set fso = CreateObject("Scripting.FileSystemObject")
cPath = fso.GetParentFolderName(ThisWorkbook.FullName)
cPathIn = cPath & "\In\"
cPathOut = cPath & "\Out\"
Set Folder = fso.GetFolder(cPathIn)
For Each File In Folder.Files
If fso.GetExtensionName(File.Name) = "txt" Then
With fso.OpenTextFile(cPathIn & File.Name, 1, True)
cIn = .ReadAll
.Close
End With
cOut = vbCrLf & "DATE"
arrL = Split(cIn, vbLf)
For i = LBound(arrL) To UBound(arrL)
If Len(arrL(i)) > 0 Then
arrD = Split(arrL(i), ",")
arrD(0) = Right(arrD(0), 2) & "." & Mid(arrD(0), 5, 2) & "." & Left(arrD(0), 4)
For j = 1 To 4
cnum = Replace(arrD(j), ".", ",")
arrD(j) = Replace(CStr(Round(CDbl(cnum), 2)), ",", ".")
Next
cnum = Replace(arrD(6), ".", ",")
arrD(6) = Replace(CStr(Round(CDbl(cnum), 0)), ",", ".")
cOut = cOut & vbCrLf & Join(Array(arrD(0), arrD(1), arrD(2), arrD(3), arrD(4), arrD(6)), vbTab)
End If
Next
With fso.OpenTextFile(cPathOut & File.Name, 2, True)
.Write cOut
.Close
End With
End If
Next
MsgBox "Ok"
End Sub
Sub replaceTxts()
Dim fso As New FileSystemObject, curFolder As Folder, curFile As File
folderPath = "D:\option programs\отбор\OUT\"
Set curFolder = fso.GetFolder(folderPath)
For Each curFile In curFolder.Files
If Right(curFile.Path, 4) = ".txt" Then
curFile.copy Replace(curFile.Path, ".txt", ".csv")
curFile.Delete
End If
Next curFile
End Sub
|