v jedné složce mám *.csv soubory obsahující 6 sloupců dat (1. sloupec obsahuje datum) a textový dokument "seznam.txt", obsahující názvy těchto csv souboru.
CSV soubory upravuji a ukládám (exportuji) do jednotlivých txt dokumentů. Ukládám pouze první sloupec obsahující datum a potom pátý sloupec - data jsou oddělená středníkem.
Problém je s ukládáním datumu ve správném formátu. Ať v excelu u datumu před exportem nastavím libovolný formát data, tak ve výsledném txt je vždy datum uloženo ve formátu dle místního jazykového nastavení počítače.
Data v txt potřebuji ve formátu dd-mm-yyyy a ne ve formátu s tečkou.
Jde do kódu doplnit nějaká proměnná, abych před spuštěním makra nemusel upravovat formát data v "místním jazykovém nastavení" PC?
Děkuji
Zde je kód:
Kód: Vybrat vše
Sub UpracaCSV()
Dim fso
Dim mySheet As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set objsoubor2 = fso.OpenTextFile(ThisWorkbook.Path & "\" & "seznam.txt", 1, True, -2)
Dim Radka As String
Dim i, j, k, l
Dim Seznam(1000, 1)
j = 1
With objsoubor2
Do While Not (objsoubor2.AtEndOfStream)
Radka = .ReadLine
Seznam(j, 1) = Radka
j = j + 1
Loop
End With
objsoubor2.Close
For k = 1 To j - 1
'smazani dat
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A1").Select
Set objsoubor4 = fso.OpenTextFile(ThisWorkbook.Path & "\" & Seznam(k, 1) & ".csv", 1, True, -2)
i = 1
With objsoubor4
Do While Not (objsoubor4.AtEndOfStream)
Radka = .ReadLine
Cells(i, 1) = Radka
i = i + 1
Loop
End With
objsoubor4.Close
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 4), Array(2, 9), Array(3, 9), Array(4, 9), Array(5, 9), Array(6, 9), _
Array(7, 1)), TrailingMinusNumbers:=True
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "dd-mm-yyyy;@"
'nazev sloupce podle nazvu souboru
Cells(1, 2) = Seznam(k, 1)
'pocet radku
Range("A1").Select
Range("A1", Selection.End(xlDown)).Select
myCount = Selection.Rows.Count
Set objsoubor3 = fso.OpenTextFile(ThisWorkbook.Path & "\" & Seznam(k, 1) & ".txt", 2, True, -2)
With objsoubor3
For l = 1 To myCount
.WriteLine Cells(l, 1) & ";" & Cells(l, 2)
Next l
End With
objsoubor3.Close
Next k
End Sub
