PDA

View Full Version : [SOLVED] Search Matched File Names in Col A - Import the Text in Col B



dj44
11-08-2016, 05:53 AM
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.

17531



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
11-09-2016, 06:33 AM
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/article/Excel-specifications-and-limits-16c69c74-3d6a-4aaf-ba35-e6eb276e8eaa?ui=en-US&rs=en-US&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
11-09-2016, 06:50 AM
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
11-09-2016, 08:47 AM
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
11-09-2016, 09:09 AM
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 :old: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 :grinhalo:

Cheers and



Thanks again my friend

:beerchug:
Have a great day !


And folks too