Search Matched File Names in Col A - Import the Text in Col B

[dj44]

Hi folks,

Good Tuesday all.
I am trying to import some matched files into my excel spreadsheet.

In column A filename it includes from my folder called Import

Column B - import the text found in each file.

ImportTextfile.png

Sub ImportMatchedFilesOnly()
 
' Only Import the Matched files
 
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
 Dim fileString  As String
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
Set objFolder = objFSO.GetFolder("C:\Users\DJ\Desktop\Import")
i = 1
 
For Each objFile In objFolder.Files
 
 
  
     Set myFiles = Range("A1:A5")
 
     If InStr(1, objFile.Name, "myFiles") <> 0 Then
    
        Open objFile.Path For Input As lFile
           
        strString = ""
      While Not EOF(lFile)
           
    Line Input #lFile, szLine
           
    ' Concatenete lines from text file to import
    fileString = fileString & vbCrLf
    
     i = i + 1
 
 
Next objFile
End Sub

It doesn't work as I did something and not sure how to fix it now.
I have found many scripts that import something but after days -well I better ask for some help

Thank you for any help

[Kenneth Hobs]

The first problem among several that I see is that the condition of InStr() would never match. Another consideration is that a filename without a file extension is impossible. Are you trying to match z1000.pdf, z1000.xlsx, z1000.txt, z1000.csv, etc.? I assume that it would be a text file of some sort.

Excel also has many other limits: number of characters in a cell, row height, etc. https://support.office.com/en-us/art...ad=US&fromAR=1

I guess if your ".txt" files were limited in size, then poking the contents into cells might make sense.

If you answer my question and still want to pursue this, please post back.

[dj44]

Hello Kenneth,
Oh yes well spotted well, I have something that can import the filenames somehwere and it does include the .txt extension.

Yes these files are very basic just a few lines of data

Save me time having to manually open them.

I found something that can include all the files for import.

But again I just didn’t want the headache of 200 txt files being imported.

So I thought if I could list a few in the column then it could import
But then I got stuck and still nothing has come to fruititon

[Kenneth Hobs]

Right click the sheet's tab, View Code, and paste.
Change the path in txtPath to suit. To update current entries, cut A2 and down and paste back. Then, any change in A will update B.

Private Sub Worksheet_Change(ByVal Target As Range)    
    Dim c As Range, r As Range, txtPath As String
    Dim hCell As Range, fn As String, fnTXT As String
    Dim glb_origCalculationMode As Integer, fso As Object
    
    On Error GoTo EndSub
    glb_origCalculationMode = Application.Calculation
    With Application
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
      .EnableEvents = False
      .DisplayAlerts = False
      .Cursor = xlWait
      .StatusBar = "Adding txt file contents..."
      .EnableCancelKey = xlErrorHandler
    End With
     
    Set r = Intersect(Target, Columns("A"))
    If r Is Nothing Then Exit Sub
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    txtPath = ThisWorkbook.Path & "\" 'Path to .txt files with trailing \.
    'If Not fso.FileExists(txtPath) Then Exit Sub
     
    For Each c In r
      Set hCell = c.Offset(, 1)
      fn = c.Value
      fnTXT = txtPath & fn & ".txt"
      
      Select Case True
        Case fn = ""
          hCell.Value = ""
        Case fso.FileExists(fnTXT)
          With hCell
            'https://msdn.microsoft.com/en-us/library/aa265341(v=vs.60).aspx
            'http://www.exceltrick.com/formulas_macros/filesystemobject-in-vba/
            .Value = fso.GetFile(fnTXT).OpenAsTextStream(1, -2).ReadAll
            '.Value = Replace(fso.GetFile(fnTXT).OpenAsTextStream(1, -2).ReadAll, vbCrLf, vbLf)
            .WrapText = True
            Columns(.Column).EntireColumn.AutoFit
            Rows(.Row).EntireRow.AutoFit
          End With
          Range(c, hCell).VerticalAlignment = xlCenter
        Case Else
      End Select
    Next c
     
EndSub:
    With Application
      .Calculation = glb_origCalculationMode
      .ScreenUpdating = True
      .EnableEvents = True
      .DisplayAlerts = True
      .CalculateBeforeSave = True
      .Cursor = xlDefault
      .StatusBar = False
      .EnableCancelKey = xlInterrupt
    End With
    Set fso = Nothing
End Sub

[dj44]

Hi Kenneth,

Thank you very much for this kind and generous help

I appreciate your time - no one got time to be sitting around for others.

This is very advanced code hats off to you

It did a stellar job.

I never knew you could import as such but it makes sense and is more effieicent this way.



Thank you for saving me the headache of having to open files indivisually 1 by 1
- you know folders get messy and I can't for the life of me tame them,
more comes in and more junk clutters up my eye sight so this is very very helpful.

Yesterday night i was looking for this and couldnt find anything so i was a bit stressed.

Alls wells now

Cheers and



Thanks again my friend


Have a great day !


And folks too