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

[vpan16]

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" ")

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

 

[Tinbendr]

something like this: (Not tested)

'.......
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

 

[SpillerBD]

Are you upgraded to 2016 version?