dj44
11-19-2016, 03:37 AM
Hi folks,
Good Saturday to all.:):)
Last week good man Kenneth was very kind to help me with this great piece of code that did this job.
I put the file name in Column A and in Column B it imported the content of that file like magic.
It is doing a STELLAR job and I am really happy with it.
Seeing that I depend on it so much now, I need to ask if someone can be kind enough to help me adapt it just 1 step further.
It currently imports only from the current workbook folder location.
I believe i need a recursion search?
Private Sub Worksheet_Change(ByVal Target As Range)
' Kenneth Annotated Version
'http://www.vbaexpress.com/forum/showthread.php?57674-Search-Matched-File-Names-in-Col-A-Import-the-Text-in-Col-B
Dim C As Range, r As Range, txtPath As String
Dim oTextImport As Range, oFileName As String, oFileNameTXT 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 oTextImport = C.Offset(, 1)
oFileName = C.Value
oFileNameTXT = txtPath & oFileName & ".txt"
Select Case True
Case oFileName = ""
oTextImport.Value = ""
Case fso.FileExists(oFileNameTXT)
With oTextImport
.Value = fso.GetFile(oFileNameTXT).OpenAsTextStream(1, -2).ReadAll
'.Value = Replace(fso.GetFile(oFileNameTXT).OpenAsTextStream(1, -2).ReadAll, vbCrLf, vbLf)
.WrapText = True
Columns(.Column).EntireColumn.AutoFit
Rows(.Row).EntireRow.AutoFit
End With
Range(C, oTextImport).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
I have found many functions for looping through subfolders on the net, but I have no clue how to actulaly use it or embed it within Kenneths code, and I did some things that broke it so - I don’t want to ruin the code.
I found a subfolder loop on this thread as well
I have scoured the whole internet for days and what I found has not been able to help me as I have mixed and matched the code and got myself in a pickle.
http://www.excelguru.ca/forums/showthread.php?462-Help-with-hyperlinking-files-in-subdirectories-to-a-list-of-filenames-in-another-work
If a pro has some spare time and wouldn’t mind advising me on how I can access a text file that may be stored in a subfolder I would be really grateful.
Thank you very much for looking at this, and I am very grateful for your time
Good Saturday to all.:):)
Last week good man Kenneth was very kind to help me with this great piece of code that did this job.
I put the file name in Column A and in Column B it imported the content of that file like magic.
It is doing a STELLAR job and I am really happy with it.
Seeing that I depend on it so much now, I need to ask if someone can be kind enough to help me adapt it just 1 step further.
It currently imports only from the current workbook folder location.
I believe i need a recursion search?
Private Sub Worksheet_Change(ByVal Target As Range)
' Kenneth Annotated Version
'http://www.vbaexpress.com/forum/showthread.php?57674-Search-Matched-File-Names-in-Col-A-Import-the-Text-in-Col-B
Dim C As Range, r As Range, txtPath As String
Dim oTextImport As Range, oFileName As String, oFileNameTXT 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 oTextImport = C.Offset(, 1)
oFileName = C.Value
oFileNameTXT = txtPath & oFileName & ".txt"
Select Case True
Case oFileName = ""
oTextImport.Value = ""
Case fso.FileExists(oFileNameTXT)
With oTextImport
.Value = fso.GetFile(oFileNameTXT).OpenAsTextStream(1, -2).ReadAll
'.Value = Replace(fso.GetFile(oFileNameTXT).OpenAsTextStream(1, -2).ReadAll, vbCrLf, vbLf)
.WrapText = True
Columns(.Column).EntireColumn.AutoFit
Rows(.Row).EntireRow.AutoFit
End With
Range(C, oTextImport).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
I have found many functions for looping through subfolders on the net, but I have no clue how to actulaly use it or embed it within Kenneths code, and I did some things that broke it so - I don’t want to ruin the code.
I found a subfolder loop on this thread as well
I have scoured the whole internet for days and what I found has not been able to help me as I have mixed and matched the code and got myself in a pickle.
http://www.excelguru.ca/forums/showthread.php?462-Help-with-hyperlinking-files-in-subdirectories-to-a-list-of-filenames-in-another-work
If a pro has some spare time and wouldn’t mind advising me on how I can access a text file that may be stored in a subfolder I would be really grateful.
Thank you very much for looking at this, and I am very grateful for your time