Loop through folder with txt files, import them and save as xls file

I am trying to write a macro that will loop through my folder of txt files

Q - every file?

import them

Q - into one sheet\ each text file to different sheets\different workbooks?

It also adds many quotation marks ("") when I only want to import using tab delimiter and comma

please attach a sample typical text file to make testing possible - easier to play with the real data

to attach a file
- click on Reply
- Click on GoAdvanced
- look below fo ManageAttachments etc

thanks

Hi

yes it is every file to loop through in the folder. They are all txt files.

They should come into separate workbooks, i.e. import one txt file into one workbook (one sheet) then save it as xls (same file name), close and open next file and so on. They all need to be saved in the same folder that the txt files are currently in.

I hope that explains it properly.

Attached is a small sample. The way I import using the wizard is to use delimited, comma, general, finish.

Hi maym,

If you were using Power Query, this would be an easy problem. See the attached. Is this what you want? Or will you only accept a VBA answer?

SampleAnswer.xlsx

I have managed to put together the following. However as shown in the sample txt file, the dates should show as 7/1/2013 (1 Jan) but when I re-open the file, they show as 1/7/2013 (1 July).

How can I solve for this??

Sub Import()
   'DECLARE AND SET VARIABLES
    Dim wbk As Workbook
    Dim FileName As String
    Dim Path As String
    Dim ws As Excel.Worksheet

        Path = "C:\Users\L\Desktop\"
        FileName = Dir(Path & "*txt")
        
   
            Do While Len(FileName) > 0  'IF NEXT FILE EXISTS THEN
            
        
                Workbooks.OpenText FileName:="C:\Users\L\Desktop\" & FileName, Origin _
                :=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
                , ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _
                , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
                Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
                Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
                16, 1), Array(17, 1), Array(18, 1)), TrailingMinusNumbers:=True                            
                               
                            
             Application.DisplayAlerts = False
              ActiveWorkbook.SaveAs Path & Left(FileName, Len(FileName) - 3) & "xls", FileFormat:=xlNormal
               
       
       ActiveWorkbook.Close True
       FileName = Dir
            Loop

End Sub

Your thread somehow disappeared off my subscribed threads list - so has not been on my radar - I will have a look later today/tomorrow and update the thread after that
kev

Unfortunately with Workbooks.OpenText, Excel brings in date&time values as numbers interpreted via application default - and Excel's native tongue is American!
(As far as I know) there is no way to fix the code to allow Workbooks.OpenText to be used and get the dates correct

Therefore forced to import the data, where everything is brought in as text
- this method adds a connection to the text file (not intending to update later - so connection is removed by VBA)
- the date & time values are now text (does not matter unless you need to perform calculations or sort)
- if that is a problem then just need to a add a function to convert date&time text to values (do you need this?)
- I noticed that columns L and N are better treated as numbers and added a routine to convert those values to numbers
- that simple routine unfortunately does not work with the date&time text (more precisely - it works but gets the answer wrong )
- other columns left as text
- your original VBA (post#7) was creating xls files, whereas this creates xlsx files (this should not be an issue given that you are using Excel 2010)


Test in attached file with {CTRL} k

Place this code in a general module:

Sub ImportIt()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim sourcePath As String, destnPath As String, FileName As String, SaveName As String, wb As Workbook
    
    sourcePath = "C:\Users\L\Desktop\"
    destnPath = sourcePath
    FileName = Dir(sourcePath & "*txt")
        
    Do While Len(FileName) > 0
        Set wb = Workbooks.Add
        Call ImportTxt(sourcePath & FileName)
        Call DeleteConnections
        Call FixNumbers
            
        SaveName = Left(FileName, InStrRev(FileName, ".") - 1)
        Application.DisplayAlerts = False
            wb.SaveAs (destnPath & SaveName)
            wb.Close False
        Application.DisplayAlerts = True
        FileName = Dir
    Loop

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Private Sub ImportTxt(strFile As String)
    'initialising data type array bigger than required is lazy but it works
    Dim ws As Worksheet, cdtArray(1 To 50) As Long, i As Long
    Set ws = ActiveSheet
        For i = 1 To UBound(cdtArray)
            cdtArray(i) = 2
        Next i

    With ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileColumnDataTypes = cdtArray
        .Refresh
    End With
End Sub

Private Sub FixNumbers()
    'required because all values imported as text
    Dim colArray(), C
    colArray = Array("L", "N")
    
    For Each C In colArray
        With Columns(C)
            .Select
            .Copy
            .PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
            .NumberFormat = "0.00"
        End With
    Next C
    Range("A1").Select
End Sub

Private Sub DeleteConnections()
    'connection no longer required
    Do While ActiveWorkbook.Connections.Count > 0
        ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
    Loop
End Sub