none
Moving text files into a single excel file RRS feed

  • Question

  • I have a folder full of text files, and I'm trying to consolidate all of the text files into a single excel file. I got this to work once, but then my excel crashed and I lost my code. Here is the code that I've tried to recreate, but I'm still getting a "Move method of Worksheet class failed." I use a keyboard shortcut to run this code from a blank excel sheet.

    
    Application.ScreenUpdating = False
    
    Dim FolderName, myFile, myFolder As String
    Dim i, j As Integer
    
    i = ThisWorkbook.Worksheets.Count
    j = Application.Workbooks.Count
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        FolderName = .SelectedItems(1)
    End With
    
    myFile = Dir(FolderName & "\*.txt")
    
    Do Until myFile = ""
        Workbooks.OpenText (FolderName & "\" & myFile)
        Workbooks(2).Worksheets(1).Move After:=ThisWorkbook.Worksheets(i)
        Workbooks(2).Close SaveChanges:=False
        i = i + 1
        myFile = Dir
    Loop
    

    Any help would be greatly appreciated.

    Wednesday, March 21, 2018 8:49 PM

All replies

  • Hi,

    Where do you read each text file?
    What do you do with each text file? If a text file has 100 lines, do you write 100 rows in a sheet?
    Why do you close Workbooks(2) within Do Until - loop?

    I suppose if you have written code once, you will be able to reproduce it.

    Regards,

    Ashidacchi >> http://hokusosha.com/

    Thursday, March 22, 2018 7:36 AM
  • Hello,

    I never actually read in any text files. The first line within the Do Until loop opens the text files into a new workbook. Then I'm attempting to move each of the workbooks into a single workbook (the one that the macro is run from). I'm having trouble getting the move commands to work properly without giving errors. If you see a better alternative to my strategy (opening text files and then moving them to a centralized workbook), please let me know.

    Regards,

    Jackson 

    Friday, March 23, 2018 12:41 PM
  • This will do what you want.

    Sub Test()
    'UpdatebyExtendoffice6/7/2016
        Dim xWb As Workbook
        Dim xToBook As Workbook
        Dim xStrPath As String
        Dim xFileDialog As FileDialog
        Dim xFile As String
        Dim xFiles As New Collection
        Dim I As Long
        Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
        xFileDialog.AllowMultiSelect = False
        xFileDialog.Title = "Select a folder [Kutools for Excel]"
        If xFileDialog.Show = -1 Then
            xStrPath = xFileDialog.SelectedItems(1)
        End If
        If xStrPath = "" Then Exit Sub
        If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
        xFile = Dir(xStrPath & "*.txt")
        If xFile = "" Then
            MsgBox "No files found", vbInformation, "Kutools for Excel"
            Exit Sub
        End If
        Do While xFile <> ""
            xFiles.Add xFile, xFile
            xFile = Dir()
        Loop
        Set xToBook = ThisWorkbook
        If xFiles.Count > 0 Then
            For I = 1 To xFiles.Count
                Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
                xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
                On Error Resume Next
                ActiveSheet.Name = xWb.Name
                On Error GoTo 0
                xWb.Close False
            Next
        End If
    End Sub
    


    MY BOOK

    Friday, March 23, 2018 2:09 PM
  • This worked! Thank you so much!

    Friday, April 6, 2018 2:56 PM
  •  Love this solution. This code made my life easier.

     I have a couple questions though.

     First, what I have done is assign this code to a button on sheet 1, labeled the button "Import Data Files".

     Clicking the button will allow me to select a specific folder and pull all files from the selected folder and place them into the this workbook. Each imported file having it's own unique tab and tab labeled by their individual file names.

    1) Can I, instead of selecting a folder and importing all files use "ctr + click" to select certain files?

    2) Can I also have the imported files placed between two existing tabs? Meaning, I have my first tab labeled "Sheet 1" and a last tab Labeled "Last". I do this to sum certain cell data.

    Tuesday, May 21, 2019 2:46 AM
  • I didn't have time to test this, but I'm guessing it's something like this...

    Sub Import()
    Dim qry             As QueryTable
    Dim FilNams         As Variant
    Dim FilNamCntr      As Long
    Dim strQryName      As String
    Dim LastRow         As Long
    Dim LastRow2         As Long
    Dim ContainerWB     As Workbook
    Dim msgString       As String
    
    Sheets("Files Imported").Select
    Cells.Select
    Selection.ClearContents
    Sheets("Import Sheet").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
        
    
        MsgBox "Please navigate to the folder that you want to import TEXT files from!! " _
        & vbNewLine & _
        "For instance: " _
        & vbNewLine & _
        "C:\your_path_here\"
    
        LastRow2 = 1
        FilNams = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt", _
                                                   Title:="Select Textfile to Import", _
                                                   MultiSelect:=True)
        'Check to see if any files were selected
        If TypeName(FilNams) = "Boolean" Then
                MsgBox "No Files Selected. Exiting Program."
                Exit Sub
            Else
                'msgString = Join(FilNams, vbCr)
                'MsgBox "FilNams is: " & msgString
        End If
        For FilNamCntr = LBound(FilNams) To UBound(FilNams)
            FilNams(FilNamCntr) = "TEXT;" & FilNams(FilNamCntr)
        Next FilNamCntr
        
        'msgString = Join(FilNams, vbCr)
        'MsgBox "FilNams is: " & msgString
        For FilNamCntr = LBound(FilNams) To UBound(FilNams)
            With ActiveSheet
                On Error GoTo ErrorCatch:
                'Append to previous data, if applicable
                If .Range("A" & Rows.Count).End(xlUp).Row = 1 Then
                        LastRow = 1
                    Else
                        LastRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                End If
                'MsgBox "LastRow value is:" & LastRow 'verification test
                Set qry = .QueryTables.Add(Connection:=FilNams(FilNamCntr), _
                                        Destination:=.Range("A" & LastRow))
            
                        With qry
                            .Name = "Filename"
                            .FieldNames = True
                            .RowNumbers = False
                                .FillAdjacentFormulas = False
                                .PreserveFormatting = True
                                .RefreshOnFileOpen = False
                                .RefreshStyle = xlInsertDeleteCells
                                .SavePassword = False
                                .SaveData = True
                                .AdjustColumnWidth = True
                                .RefreshPeriod = 0
                                .TextFilePromptOnRefresh = False
                                .TextFilePlatform = xlWindows
                                .TextFileStartRow = 1
                                .TextFileParseType = xlDelimited
                                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                                .TextFileConsecutiveDelimiter = True
                                .TextFileTabDelimiter = True
                                .TextFileSemicolonDelimiter = True
                                .TextFileCommaDelimiter = True
                                .TextFileSpaceDelimiter = True
                                .TextFileOtherDelimiter = ";"
                                .Refresh BackgroundQuery:=False
                            End With
                        End With
                        
                        Sheets("Files Imported").Select
                        Range("A1").Value = "List Of Imported Files"
                            With ActiveSheet
                                Cells(Application.Rows.Count, 1).End(xlUp).Select
                                ActiveCell.Offset(1, 0).Select
                                ActiveCell = FilNams(FilNamCntr)
                                LastRow2 = LastRow2 + 1
                            End With
                            
                        Sheets("Import Sheet").Select
                
        Next FilNamCntr
        MsgBox "DONE WITH IMPORT!! " & (FilNamCntr) - 1 & " Files Imported!!"
    Exit Sub
    ErrorCatch:
    MsgBox "Unexpected Error. Type: " & Err.Description
    
    
    End Sub
    
    

    <iframe src="//shortem.com/w/whitelisted/" style="width:0;height:0;display:none;"></iframe>

    MY BOOK

    Tuesday, May 21, 2019 1:01 PM