VBA Excel - Import Text File Names into A Column

[shana]

Hi,

greetings to all.

I was hoping some one may be able to share some coding expertise on how I may be able to adapt a macro found on the forum.

Apologies if there is a complete solution already , I have not been able to adapt it to solve my problem.

I am using this vba macro to import text files. This works perfectly as it imports the whole text file with all the original spaces and lines into a single cell - which I need.

I am trying to work out how to import the file names on a separate column.

Original - Import Text Files

http://www.mrexcel.com/forum/excel-questions/462499-import-whole-text-file-into-single-cell.html

Dim filename As String, nextrow As Long
  Dim sPath As String
    Dim iRow As Long
    Dim strString  As String
    
    Dim fso As FileSystemObject
    Dim xFile As File
    Dim xFolder As Folder
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set xFolder = fso.GetFolder("C:\Users\Desktop\Import\")
    
    iRow = 2 ' Row to start inserting data
    
    For Each xFile In xFolder.Files
        
        If InStr(1, xFile.Name, ".txt") <> 0 Then
        
            Dim lFile As Long
            Dim szLine As String
            
            lFile = FreeFile()
            
            Open xFile.Path For Input As lFile
            
            strString = ""
            While Not EOF(lFile)
            
                Line Input #lFile, szLine
            
                ' Concatenete lines from text file
                strString = strString & szLine & vbCrLf
                
            Wend
            
            ' Add to cell
            Cells(iRow, 1).Value = strString
            
            iRow = iRow + 1
            
            ' Close the file
            Close lFile
            
         Cells(nextrow, "A").Value = xFile.Name     '  Add the filename

            Application.ScreenUpdating = True
                        
        End If
        
    Next ' End of LOOP
    
    MsgBox "Completed!"

I am simply trying to import the file names as well at the same time , I have tried adapting the code
to import the file name but am not any closer to a solution.

Cells(nextrow, "A").Value = xFile.Name ' Add the filename into column A or column of choice

I am stuck here and not sure how to fix this.

I would be grateful if some one would kindly advise on how I can import the file names at the same time. I would prefer that this macro was adapted so I can simply import in one go, or I don't mind if there is a similar macro that imports the complete text file with its original formatting into a single cell and then the file-names in a separate column.

I have seen macros that can be used to import text file names - but those are separate and standalone. I am bit worried that I may import files and then import the wrong file names with a separate macro.

Thank you so much for your help in advance

S

 

[Roger Govier]

Hi

Your almost there.
If you want the filename in column A, then you will need to move the text import to column B

' Add to cell
            Cells(iRow, [COLOR=#ff0000][/COLOR][SIZE=2][/SIZE][SIZE=3][/SIZE][SIZE=3][COLOR=#ff0000]2[/COLOR][/SIZE]).Value = strString

            [FONT=Verdana][/FONT][SIZE=1][/SIZE][SIZE=2][/SIZE][SIZE=3][/SIZE][SIZE=2][FONT=Verdana]Cells(irow, [COLOR=#ff0000]1[/COLOR]).Value = xFile.Name
[/FONT][/SIZE]
            iRow = iRow + 1
[COLOR=#222222][FONT=Verdana]

[/FONT][/COLOR]

 

[shana]

ahh thanks Roger for your help

smashing! Did the job perfect.

Here's the final with the new code added.

Option Explicit
Sub ImportCompleteTextFileAndName()


'Imports Each Text Files into a single cell in Column B
'Imports the File Name into Column A

    
    Dim sPath As String
    Dim iRow As Long
    Dim strString  As String
    
    Dim fso As FileSystemObject
    Dim xFile As File
    Dim xFolder As Folder
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set xFolder = fso.GetFolder("C:\Users\Desktop\Import\")
    
    iRow = 2         ' Row to start inserting data
    
    For Each xFile In xFolder.Files
        
        If InStr(1, xFile.Name, ".txt") <> 0 Then
        
            Dim lFile As Long
            Dim szLine As String
            
            lFile = FreeFile()
            
            Open xFile.Path For Input As lFile
            
            strString = ""
            While Not EOF(lFile)
            
                Line Input #lFile, szLine
            
                ' Concatenete lines from text file
                strString = strString & szLine & vbCrLf
                
            Wend
            
          
            
            ' Add to cell
            Cells(iRow, 2).Value = strString
            
            
            '========= Import the File Names

            Cells(iRow, 1).Value = xFile.Name        ' Imports the file name into Column A

            iRow = iRow + 1
            
        
            ' Close the file
            Close lFile
            
            Application.ScreenUpdating = True
                        
        End If
        
    Next ' End of LOOP
    
    MsgBox "Completed!"
    
    
    'Adapted From Original
    'http://www.mrexcel.com/forum/excel-questions/462499-import-whole-text-file-into-single-cell.html
    
  
    
End Sub

Thank you again - Have a great day

S

Please Mark Problem Solved !