Tudi sam sem si pomagal z odgovori, ki so bili že dani tukaj in malo snemanja...
Koda: Izberi vse
Sub Preglej_txt_dat_v_mapi()
Dim Mapa As String
Mapa = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Dim Datoteka
Dim i As Integer
i = 0
Datoteka = Dir(Mapa & "\*.txt")
Do While Datoteka <> ""
i = i + 1
Dim polnoIme As String
polnoIme = Mapa & "\" & Datoteka
Workbooks.OpenText Filename:= _
polnoIme, _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
ActiveWorkbook.SaveAs Filename:= _
Mapa & "\" & ActiveWorkbook.ActiveSheet.Name & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Datoteka = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Najdeno in preimenovano " & i & _
" txt datotek...", vbInformation, "Preimenovanje"
End Sub