Identifying text file names and importing on single Excel sheet RRS feed

  • Question

  • Hey!

    Does anybody can help me with Excel VBA macro code in order to import data from text files into single Excel spread sheet? I want to create User Form where user can select start and end date of interest and macro code will import bunch of text files depending on user demands...

    My text files are named: 20130619004948DataLog.txt (meaning: yyyy mm dd hh mm ss). Text file contains recordings for each 15 seconds... It would be great to omit time tail (meaning that user can only specify date). Text files for one day of interest (I have text files covering whole year):

























    Option Explicit
    Sub SearchFiles()
        Dim file As Variant
        Dim x As Integer
        Dim myWB As Workbook
        Dim WB As Workbook
        Dim newWS As Worksheet
        Dim L As Long, t As Long, i As Long
        Dim StartDateL As String
        Dim EndDateL As String
        Dim bool As Boolean
        bool = False ' to check if other versions are present
        StartDateL = Format(Calendar1, "yyyymmdd")
        EndDateL = Format(Calendar2, "yyyymmdd")
    ' I am using Userform asking user to select the date and time range of interet,
    ' However, I want to use only the date to filter the files having the name with that particular date
        file = Dir("c:\myfolder\") ' folder with all text files
    ' I need assistance with the following part:
    '1) How to filter and select the files between StartDateL and EndDateL_
    '(including files with that dates as well)?
        While (file <> "")
            If InStr(file, StartDateL) > 0 Then 'Not sure if the statements inside parenthesis is correct
                bool = True
                GoTo Line1:
            End If
            file = Dir
        If Not bool Then
            file = "c:\myfolder\20130115033100DataLog.txt" 'Just for a test that the code works as intended
        End If
    'This part for the selected text files to be loaded on a single Excel Sheet.
        Set myWB = ThisWorkbook
        Set newWS = Sheets(1)
        L = myWB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
        t = 1
        For x = 1 To UBound(file)
            Workbooks.OpenText Filename:=file(x), DataType:=xlDelimited, Tab:=True, Semicolon:=True, Space:=False, Comma:=False
            Set WB = ActiveWorkbook
            WB.Sheets(1).UsedRange.Copy newWS.Cells(t, 2)
            t = myWB.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1
            WB.Close False
            Application.ScreenUpdating = False
            Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End Sub

    Tuesday, February 10, 2015 11:16 AM

All replies

  • Does anybody can help me with Excel VBA macro code in order to import data from text files into single Excel spread sheet? I want to create User Form where user can select start and end date of interest and macro code will import bunch of text files depending on user demands...


    Can you zip a couple of your text files, upload the zip file on an online file hoster like and post the download link here?


    Tuesday, February 10, 2015 12:08 PM
    Tuesday, February 10, 2015 7:59 PM
  • I have added few text files (the link above). These are text files for few hours at the same day. If you could help me with the filter of the files and loading them on single Excel sheet, I would appreciate that very much.
    Wednesday, February 11, 2015 9:02 AM
  • - Make a new Excel file

    - Open the VBA editor
    - Add a Userform
    - Place 2 text boxes and 1 command button on that form
    - Paste all code below into the code module of the form
    - Download this file:

    - In the VBA editor press CTRL-M and import that file
    - Save the Excel file in the directory that contain your text files
    - Run the form

    You can format the columns of the sheet as you like, e.g. column E:H should be a number with 5 decimal places. The top row can contain some headings. My code did not affect the formatting or the headings.


    Option Explicit
    Private Sub UserForm_Initialize()
      'Just a sample
      Me.TextBox1.Value = FormatDateTime(Now, vbGeneralDate)
      Me.TextBox2.Value = FormatDateTime(Now, vbShortDate)
    End Sub
    Private Sub CommandButton1_Click()
      Dim StartDate As Date, EndDate As Date
      Dim FS As New FileSearch
      Dim R As Range
      Dim ThisFile As Variant
      Dim ThisDate As Date
      Dim Data As Variant
      Dim Count As Long
      'Be sure we have 2 dates
      If Not IsDate(Me.TextBox1.Value) Then
        MsgBox "No start date"
        Exit Sub
      End If
      If Not IsDate(Me.TextBox2.Value) Then
        MsgBox "No end date"
        Exit Sub
      End If
      'Convert to real dates
      StartDate = CDate(Me.TextBox1.Value)
      EndDate = CDate(Me.TextBox2.Value)
      'Time part given?
      If Fix(EndDate) = EndDate Then
        'No include all files for this day
        EndDate = EndDate + TimeSerial(23, 59, 59)
      End If
      'Correct order?
      If StartDate > EndDate Then
        ThisDate = EndDate
        EndDate = StartDate
        StartDate = ThisDate
      End If
      With FS
        'Same path as our file
        .LookIn = ThisWorkbook.Path
        .FileName = "*DataLog.txt"
        'Search all files sort by file name
        If .Execute(msoSortByFileName, msoSortOrderAscending) = 0 Then
          MsgBox "No data files found in " & .LookIn
          Exit Sub
        End If
        'Clear previous data
        Set R = Range("A2").CurrentRegion
        If R.Row < 2 Then Set R = R.Offset(1)
        'Show the user that we are working
        Application.Cursor = xlWait
        For Each ThisFile In .FoundFiles
          'Get the date from the file name
          ThisDate = Filename2Date(ThisFile)
          'Between our dates?
          If (ThisDate >= StartDate) And (ThisDate <= EndDate) Then
            'Import at the end of the data
            Set R = Range("A" & Rows.Count).End(xlUp).Offset(1)
            Data = ReadCSV(ThisFile)
            R.Resize(UBound(Data) + 1, UBound(Data, 2) + 1) = Data
            Count = Count + 1
          End If
      End With
      Application.Cursor = xlDefault
      If Count = 0 Then
        MsgBox "No files match your dates"
        MsgBox Count & " files imported"
        'Hide the form
      End If
    End Sub
    Private Function Filename2Date(ByVal Fullname As String) As Date
      'Convert e.g "C:\20130601142648DataLog.txt" to the date "01.06.2013 14:26:48"
      Dim i As Long, j As Long
      i = InStrRev(Fullname, "\")
      If i > 0 Then Fullname = Mid(Fullname, i + 1)
      Fullname = JustNumbers(Fullname)
      If Len(Fullname) <> 14 Then Exit Function
      Filename2Date = _
        DateSerial(Mid(Fullname, 1, 4), Mid(Fullname, 5, 2), Mid(Fullname, 7, 2)) + _
        TimeSerial(Mid(Fullname, 9, 2), Mid(Fullname, 11, 2), Mid(Fullname, 13, 2))
    End Function
    Private Function JustNumbers(ByVal What As String) As String
      'Return only numbers from What (by Rick Rothstein)
      Dim i As Long, j As Long, Digit As String
      For i = 1 To Len(What)
        Digit = Mid$(What, i, 1)
        If Digit Like "#" Then
          j = j + 1
          Mid$(What, j, 1) = Digit
        End If
      JustNumbers = Left$(What, j)
    End Function
    Private Function ReadCSV(ByVal Fullname As String) As Variant
      'Read a CSV file into an array
      Const LDelim = vbCrLf 'Line delimiter
      Const FDelim = ";"    'Field delimiter
      Dim hFile As Integer
      Dim Buffer As String
      Dim Lines, Line, Data
      Dim i As Long, j As Long
      'Be sure the file exists
      If Dir(Fullname) = "" Then Exit Function
      'Open and read all data
      hFile = FreeFile
      Open Fullname For Binary Access Read As #hFile
      Buffer = Space(LOF(hFile))
      Get #hFile, , Buffer
      Close #hFile
      'Split into lines
      Lines = Split(Buffer, LDelim)
      'Split the first line and prepare the output
      'Note: I assume that all lines have the same number of fields
      Line = Split(Lines(0), FDelim)
      ReDim Data(0 To UBound(Lines), 0 To UBound(Line))
      For i = 0 To UBound(Lines)
        Line = Split(Lines(i), FDelim)
        For j = 0 To UBound(Line)
          'Parse the fields
          If IsDate(Line(j)) Then
            Data(i, j) = CDate(Line(j))
          ElseIf IsNumeric(Line(j)) Then
            Data(i, j) = CDbl(Line(j))
            Data(i, j) = Line(j)
          End If
      ReadCSV = Data
    End Function

    Wednesday, February 11, 2015 11:11 AM
  • Dear Andreas,

    Thank you for your help, I haven't tried to run the code yet, but I am afraid of the file that you send me... what does it do? What is there?

    Friday, February 13, 2015 7:38 AM
  • You mean the FileSearch.cls? This is my publicly known file search class.

    This feature was available in Office till version 2003 and removed with 2007.

    When you import that file, you get the feature back.

    EDIT: When you are afraid to run code from other people, I recommend to use a virtual machine for testing purposes (which I also use when I download Excel files). Have a look here:


    Friday, February 13, 2015 8:08 AM
  • Dear Andreas,

    I am very thankful for your help and assistance, but is there a simpler way do execute things? This code is way to much complicated, takes time and isn't robust... Of course I am completely green in VBA, but I want to loop through files in single folder and grab the correct ones to import... Should it be so complicated to perform such a simple task?

    Please share with me any other ideas, how I should do that...

    Friday, February 13, 2015 8:32 AM
  • Moreover, I face there is a bug that stops routine. As well as indicators shows constant load of data (the circle in picture)
    Friday, February 13, 2015 8:44 AM
  • I have a bug that is indicated on screen when running the code... As well as indicator always displays loading mode. Any suggestions?
    Friday, February 13, 2015 8:46 AM
  • The CSV file is bad or different from the file that you have shown. Look in my profile for my mail address and send me that file.


    Friday, February 13, 2015 11:04 AM