none
Merging workbooks with VBA - ignore hidden files RRS feed

  • Question

  • I am using the below code to take data from a number of workbooks and combine them into a single sheet. It was working perfectly, until a hidden thumbs.db file appeared and started causing errors. I can't delete it and I can't stop it coming back (I'm using a work server and they can't turn off the function). Is there a way I can modify the below so it either only looks at .xlsx files or to tell it to ignore hidden system files in the location?

    Sub mergeworklists()
    'Combining first sheet of multiple workbooks in a folder into 1 worksheet
    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")
    
    ' folder path where individual team lists are saved
    Set dirObj = mergeObj.Getfolder("file\path\here")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
    Set bookList = Workbooks.Open(everyObj)
    
    'copies data starting at cell A6
    Range("A6:S" & Range("A65536").End(xlUp).Row).Copy
    ThisWorkbook.Worksheets(1).Activate
    
    'Pastes values with source formatting
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    Application.CutCopyMode = False
    bookList.Close
    Next
    End Sub



    • Edited by Lalala168 Wednesday, August 2, 2017 10:54 AM
    Wednesday, August 2, 2017 10:52 AM

Answers

  • You could check whether the file is an Excel workbook:

        ...
    
        For Each everyObj In filesObj
            If LCase(everyObj.Name) Like "*.xls*" Then
                Set bookList = Workbooks.Open(everyObj)
    
                'copies data starting at cell A6
                Range("A6:S" & Range("A65536").End(xlUp).Row).Copy
    
                'Pastes values with source formatting
                ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
                    Paste:=xlPasteAllUsingSourceTheme
                Application.CutCopyMode = False
                bookList.Close
            End If
        Next everyObj
    
        ...


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Lalala168 Wednesday, August 2, 2017 2:16 PM
    Wednesday, August 2, 2017 12:18 PM

All replies

  • Is there a way I can modify the below so it either only looks at .xlsx files

    Sure, try the code below.

    Andreas.

    Sub MergeWorklists()
      'Combining first sheet of multiple workbooks in a folder into 1 worksheet
      Dim bookList As Workbook
      Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
      Application.ScreenUpdating = False
      Set mergeObj = CreateObject("Scripting.FileSystemObject")
    
      ' folder path where individual team lists are saved
      Set dirObj = mergeObj.Getfolder("file\path\here")
      Set filesObj = dirObj.Files
      For Each everyObj In filesObj
        If everyObj.Name Like "*.xlsx" Then
          Set bookList = Workbooks.Open(everyObj.Name)
      
          'copies data starting at cell A6
          Range("A6:S" & Range("A65536").End(xlUp).Row).Copy
          ThisWorkbook.Worksheets(1).Activate
      
          'Pastes values with source formatting
          Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
          Application.CutCopyMode = False
          bookList.Close
        End If
      Next
    End Sub

    Wednesday, August 2, 2017 12:13 PM
  • You could check whether the file is an Excel workbook:

        ...
    
        For Each everyObj In filesObj
            If LCase(everyObj.Name) Like "*.xls*" Then
                Set bookList = Workbooks.Open(everyObj)
    
                'copies data starting at cell A6
                Range("A6:S" & Range("A65536").End(xlUp).Row).Copy
    
                'Pastes values with source formatting
                ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
                    Paste:=xlPasteAllUsingSourceTheme
                Application.CutCopyMode = False
                bookList.Close
            End If
        Next everyObj
    
        ...


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Lalala168 Wednesday, August 2, 2017 2:16 PM
    Wednesday, August 2, 2017 12:18 PM
  • Thanks for the help Andreas. I got a basic '400' error when i tried this, but I have found that the response below works so i'll just use that. Thanks for taking the time, though.
    • Edited by Lalala168 Wednesday, August 2, 2017 2:17 PM
    Wednesday, August 2, 2017 2:16 PM
  • This has worked Hans. Thank you for your help.
    • Edited by Lalala168 Wednesday, August 2, 2017 2:17 PM
    Wednesday, August 2, 2017 2:16 PM