Importing text using the FileSystemObject

[imranolas]

Hi,

I have a spreadsheet with a column of txt filenames. I'm trying to import the text from each file to the adjacent cell using VBA, so far without luck. My VBA skills are very basic, so any help would be greatly appreciated.

Thanks

[twinnyfo]

imranolas,

What code have you tried so far? Are you getting errors or just not the desired results?

[imranolas]

twinnyfo,

I've played with the filesystemobjec t and managed to pull the text from a single file to a single cell. However, I'm just a little stuck with how I would pull all text files to their relevant cells.

I tried to make it work as a function as below, but I expect I was being a little naive.

Function filetext(filename As String)

Dim fso As New FileSystemObject
Dim ts As TextStream

Set ts = fso.OpenTextFile(filename)
filetext = ts.ReadAll
ts.Close
End Function

[twinnyfo]

Was the code above successful? How big are your text files, or are they relatively small?

I know it is possible to insert values into particluar cells in Excel, so what have you tried so far?

[imranolas]

The files are fairly small, only 4 or 5 lines each. The above code returns #VALUE!.

I know the method works if I specify exactly the filename and destination like so.

Sub filetext()

Dim fso As New FileSystemObject
Dim ts As TextStream

Set ts = fso.OpenTextFile("C:\Text\A0001.txt")

ActiveSheet.Range("A1").Value = ts.ReadAll

ts.Close

End Sub

I just don't know how to do much more with it.

[twinnyfo]

So, if I understand Post #1 correctly, you have a list of filenames in a particular column of a spreadsheet, and you want to take that filename, open it, and transfer the contents of that file, and paste it into the column adjacent to the filename?

I do believe you are much closer than you realize.

Now, one really easy way to do this would be to link the spreadsheet to your databse, to treat it as a table. However, if there are mutiple spreasheets, this would defeat the purpose of automating here. Also, based on your code provided, it appears that your Spreadsheet has already been opened and you are able to write to specific cells already? Again, I think you are very close.

If you are able to access the filenames, you simply need to keep track of which cell the name came from and then insert the text into the next column over. You must be sure that you take into account the full path and filename, so if the cell contains the filename "A0001.txt" , at some point you must know that the filename you will use for your purposes will have to become: "C:\Text\A0001. txt".

There are some differences in your two listed sets of code, so let me try this:

Sub filetext(FileName as String, CellRange as String) 
    Dim fso As New FileSystemObject
    Dim ts As TextStream
    Set ts = fso.OpenTextFile("C:\Text\" & FileName)
    ActiveSheet.Range(CellRange).Value = ts.ReadAll
    ts.Close
End Sub

The key here will be establishing the correct CellRange. If your Filenames are in column A and you want to write into column B, then CellRange will be "B1", "B2"... etc., based on the source of the FileName.

You may need to play with the code and validate that you are pulling the proper filenames, but I think you are almost there!

[twinnyfo]

There are also ways to open the Excel Application from within VBA, and make direct updates. This would allow you to cycle through that first column of file names, and as long as the filename is not null, add the contents of the file.

[imranolas]

You understand correctly. Although, I don't actually require this to be part of a database.

How would I apply this code to every value in the column?

Do I need to cycle the through the column like you've suggested? As this was my initial thought.

Thanks, I appreciate your help with this.

[twinnyfo]

If you can hold on for a few minutes, I'll try to throw together some rough code for you...

[twinnyfo]

imranolas,

OK - did a little testing and tweaking and this should get you going down the right road:

Option Compare Database
Option Explicit

Private Sub UpdateExcelText()
On Error GoTo EH
    'Declare your variables
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlWS As Excel.Worksheet
    Dim intRow As Integer
    Dim strFileName As String
    Dim fso As New FileSystemObject
    Dim ts As TextStream

    'Open Excel and get to the worksheet
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Open("C:\Path\FileContents.xlsx", , False)
    Set xlWS = xlWB.Worksheets("SheetName")

    intRow = 1
    Do While Not xlWS.Range("A" & intRow).Value = ""
        'Find the Filename
        strFileName = xlWS.Range("A" & intRow).Value
        
        'Borrowing some of your code.....
        Set ts = fso.OpenTextFile("C:\Path\" & strFileName)
        xlWS.Range("B" & intRow).Value = ts.ReadAll
        ts.Close
        intRow = intRow + 1
    Loop
    xlWB.SaveAs "C:\Path\FileContents - Update.xlsx"
    xlApp.Quit
    Set xlApp = Nothing
    Exit Sub
EH:
    MsgBox Err.Number & Err.Description
    Exit Sub
End Sub

Of course, there are assumptions concerning the location of the filenames in the Spreadsheet, as well as file names and sheet names.

Hope this hepps!

[imranolas]

Oh wow! That's brilliant, thanks. I have to confess I had another attempt before seeing your post and was successful.

You were right that I was close. Turns out it was a couple of rogue double quotes in the filenames that was causing me trouble.

Thanks again for your help.

[twinnyfo]

Glad we could help. Your post also gave me a couple extra tools for my kit bag, as well!

Warm regards!