open all txt files in a folder as different excel workbooks?

vpan16

Board Regular
Joined
Jun 13, 2016
Messages
92
Hi All,

I have a code that opens all .csv files in a folder as individual workbooks then copies all workbooks into a single sheet.

I was wondering how I can apply this same idea to .txt files?

I dont care that all the information is on a single cell in the .txt files, I will delimit later. I just have over 300+ files to merge first so that is what I need.

This is the code I have for the .csv files (i tried to change the extension to .txt in the code but nothing happened ... " fCSV = Dir(fPath & "*.txt" ")

Rich (BB code):
Sub ImportCSVsWithReference()
'Imports all the CSV files in one destination folder into a singlesheet


'(IE dates over to dates) if they are not there, removes duplicates, then deletes files from local directory


Dim wbCSV   As Workbook
Dim wsMstr  As Worksheet:   Set wsMstr = ThisWorkbook.Sheets("Readership")
Dim fPath   As String:      fPath = downloads   'path to CSV files, include the final \
Dim fCSV    As String
Dim ftxt    As String
Dim FileName As String
Dim r As Range
Dim LastRow As Long
Dim quest As Integer


Application.ScreenUpdating = False


    quest = MsgBox("Would you like to Clear the existing data before importing?", _
                   vbYesNo + vbQuestion, "Clean Readership Report")
    If quest = vbYes Then
        wsMstr.UsedRange.Clear
        Range("A1") = "Story ID"
        Range("B1") = "Wire"
        Range("C1") = "Class"
        Range("D1") = "Customer #"
        Range("E1") = "Customer Name"
        Range("F1") = "Firm #"
        Range("G1") = "UUID"
        Range("H1") = "User Name"
        Range("I1") = "Business Email"
        Range("J1") = "Alternate Email"
        Range("K1") = "User Country"
        Range("L1") = "User State"
        Range("M1") = "User City"
        Range("N1") = "Transaction ID"
        Range("O1") = "Story Headline"
        Range("P1") = "Post Date"
        Range("Q1") = "Read Date"
        Range("R1") = "File Name"
        Range("S1") = "Processed"
    ElseIf quest = vbNo Then
        Range("A1:S1").Select
        Selection.AutoFilter
    End If


fCSV = Dir(fPath & "*.csv")         'start the CSV file listing


    Do While Len(fCSV) > 0
      'open a CSV file
        Set wbCSV = Workbooks.Open(fPath & fCSV)
        FileName = ActiveSheet.Name
        ActiveSheet.UsedRange.Copy wsMstr.Range("A" & Rows.Count).End(xlUp).Offset(1)
        wbCSV.Close False
        LastRow = wsMstr.Range("A" & Rows.Count).End(xlUp).Row
        For Each r In wsMstr.Range("$Q$2:Q" & LastRow)
            If IsEmpty(r.Offset(0, 1)) Then
                r.Offset(0, 1).Value = FileName
            End If
        Next r
      'ready next CSV
        fCSV = Dir
    Loop
        
wsMstr.Activate


Application.ScreenUpdating = True


Call RemoveDupes
'Call deletefiles



End Sub
 

Some videos you may like

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Tinbendr

Well-known Member
Joined
Jul 21, 2010
Messages
997
something like this: (Not tested)
Code:
'.......
fCSV = Dir(fPath & "*.txt")         'start the CSV file listing

    Do While Len(fCSV) > 0
      'open a CSV file
        Worksheet.Add
        ActiveSheet.Name = fCSV
        Macro2 fCSV
        fCSV = Dir
    Loop
        
wsMstr.Activate

Application.ScreenUpdating = True

Call RemoveDupes
'Call deletefiles
End Sub
Sub Macro2(Filename As String)
'
' Macro2 Macro
'
'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\owner\Documents\" & Filename, Destination:=Range("$A$1"))
        .Name = Filename
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,123,514
Messages
5,602,086
Members
414,501
Latest member
mdhaumyu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top