-1

I have a daily dump of 2 different text files (in the same folder) that get overwritten daily. I would like to be able to import them into an active spreadsheet with tab delimited, at the same time with a VBA code. I would really appreciate the help!

I am using excel 2016. My manual import method of 1 of the text file when recorded gives this code which is how i would like BOTH the text files to be imported (formatting preserved):

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Mr D\Music\New folder\B.txt", Destination:=Range("$A$1"))
        .CommandType = 0
        .Name = "B"
        .FieldNames = True
        .RowNumbers =enter code here False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

The code that i have tried using is from other similar questions posted here does not seem to work:

Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range

' Get a FileSystem object
Set fso = New FileSystemObject

' get the directory you want
Set folder = fso.GetFolder("C:\Users\Mr D\Music\")

' set the starting point to write the data to
Set cl = ActiveSheet.Cells(1, 1)

' Loop thru all files in the folder
For Each file In folder.Files
    ' Open the file
    Set FileText = file.OpenAsTextStream(ForReading)

    ' Read the file one line at a time
    Do While Not FileText.AtEndOfStream
        TextLine = FileText.ReadLine

        ' Parse the line into | delimited pieces
        Items = Split(TextLine, "|")

        ' Put data on one row in active sheet
        For i = 0 To UBound(Items)
            cl.Offset(0, i).Value = Items(i)
        Next

        ' Move to next row
        Set cl = cl.Offset(1, 0)
    Loop

    ' Clean up
    FileText.Close
Next file

Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing

End Sub
Community
  • 1
  • 1
Dani
  • 1
  • 1
  • 3
  • What help would you like? Your question doesn't explain what problems you are having. – YowE3K Jan 07 '18 at 05:39
  • 2
    If the filenames don't change from day to day, you could create data connections to them and refresh each day. – Mark Fitzgerald Jan 07 '18 at 05:57
  • I would like the code that can execute this. You are correct i need the data connection and would want to refresh every day. I have looked through similar questions here and the vba code mentioned is not executing it accordingly. – Dani Jan 07 '18 at 06:05
  • I have been able to get rid of user defined error by activating the Windows Script Host Object Model. I can open 1 text file, but unable to load both at the same time (the second one immediately in the last empty row) – Dani Jan 07 '18 at 06:07
  • Instead of explaining your problems in the comments, [edit the question](https://stackoverflow.com/posts/48134634/edit) to explain what issues you are having, and to include the code that you are having the issues with. **Then** we might have something we can help you with. – YowE3K Jan 07 '18 at 06:15

1 Answers1

0

do like this if your text files is with tab delimited.

Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
Dim sFolder As String, vDB, Ws As Worksheet
Dim rngT As Range
' Get a FileSystem object
Set fso = New FileSystemObject

    ' get the directory you want

    sFolder = "C:\Users\Mr D\Music\"
    Set folder = fso.GetFolder(sFolder)
    ' set the starting point to write the data to
    Set Ws = ActiveSheet
    'Set cl = ActiveSheet.Cells(1, 1)

    ' Loop thru all files in the folder
    For Each file In folder.Files
        Workbooks.Open Filename:=sFolder & file.Name, Format:=1
        With ActiveWorkbook.ActiveSheet
            vDB = .UsedRange
        End With
        ActiveWorkbook.Close
        Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2)
        rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
    Next file
    Ws.Range("a1").EntireRow.Delete
    Set FileText = Nothing
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing

End Sub

From the second text file, the header will be ignored.

Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
Dim sFolder As String, vDB, Ws As Worksheet
Dim rngT As Range
' Get a FileSystem object
Set fso = New FileSystemObject

    ' get the directory you want

    sFolder = "C:\Users\Mr D\Music\"
    Set folder = fso.GetFolder(sFolder)
    ' set the starting point to write the data to
    Set Ws = ActiveSheet
    'Set cl = ActiveSheet.Cells(1, 1)
    Ws.Cells.Clear
    ' Loop thru all files in the folder
    For Each file In folder.Files
        i = i + 1
        Workbooks.Open Filename:=sFolder & file.Name, Format:=1
        With ActiveWorkbook.ActiveSheet
            If i = 1 Then
                vDB = .UsedRange
            Else
                vDB = .UsedRange.Offset(1)
            End If
        End With
        ActiveWorkbook.Close
        Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2)
        rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
    Next file
    Ws.Range("a1").EntireRow.Delete
    Set FileText = Nothing
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing

End Sub
Dy.Lee
  • 7,527
  • 1
  • 12
  • 14
  • This worked!!! Thank you so much! I am assigning this macro to a button to do this and will be doing this daily as i rewrite the text files get updated daily with a new update. There is 1 more thing i would like to do and that is when the loop executes on the SECOND text file i would want the headers (titles on the first row) to be ignored and it loops from the second row. How can that be accomplished? – Dani Jan 07 '18 at 15:32
  • vDB = .UsedRange.offset (1) – Dy.Lee Jan 07 '18 at 15:38
  • Adding the above deletes it for BOTH text files. I just want it to delete for the second text file. – Dani Jan 07 '18 at 16:16
  • If i wanted to "call" this macro from a different worksheet, how would i adjust this code as this for activesheet... – Dani Dec 10 '18 at 16:54
  • @Dani, Set Ws = ActiveSheet to Set Ws = Sheets("sheet name") – Dy.Lee Dec 10 '18 at 17:38
  • Will anyone demonstrate below code? Workbooks.Open Filename:=sFolder & file.Name, Format:=1 With ActiveWorkbook.ActiveSheet If i = 1 Then vDB = .UsedRange Else vDB = .UsedRange.Offset(1) End If End With ActiveWorkbook.Close Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2) rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB Next file Ws.Range("a1").EntireRow.Delete Set FileText = Nothing Set file = Nothing Set folder = Nothing Set fso = Nothing – Ravindra Bisht Dec 19 '21 at 16:33