combining a ton of workbooks

Sub addToMaster()
Dim xBook As Workbook
Dim xSheet As Worksheet
Dim xStr As String
For Each xBook In ThisWorkbook.Parent.Workbooks
    If Not (ThisWorkbook Is xBook) Then
        For Each xSheet In xBook.Sheets
            On Error Resume Next
            xStr = ThisWorkbook.Sheets(xSheet.Name).Name
            If Err <> 0 Then
                With xSheet
                   ThisWorkbook.Sheets.Add.Name = .Name
                   .UsedRange.Copy _
                       Destination:=ThisWorkbook.Sheets(.Name).Range(.UsedRange.Address)
                 End With
            End If
            On Error Goto 0
        Next xSheet
    End If
Next xBook
End Sub

Option Explicit
Public strPath As String

Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
                                     Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
                                   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer

    '   Root folder = Desktop
    bInfo.pidlRoot = 0&

    '   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If

    '   Type of directory to return
    bInfo.ulFlags = &H1

    '   Display the dialog
    x = SHBrowseForFolder(bInfo)

    '   Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function

Sub CombineWorkbooks()
Dim CurFile As String
Dim DestWB As Workbook
Dim ws As Object 'allows for different sheet types
Dim DirLoc As String
'directory name


   On Error GoTo CombineWorkbooks_Error

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    DirLoc = GetDirectory & "\"
    
    Set DestWB = Workbooks.Add
    
    CurFile = Dir(DirLoc & "*.xls")
    If CurFile = vbNullString Then Exit Sub
    
    Do While CurFile <> vbNullString
        Dim OrigWB As Workbook
        
        Set OrigWB = Workbooks.Open(Filename:=DirLoc & CurFile, ReadOnly:=True)
        
        CurFile = Left(Left(CurFile, Len(CurFile) - 4), 29) 'Limits to valid sheet names
        'and removes ".xls"
        
        For Each ws In OrigWB.Sheets
            ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
        Next
        
        OrigWB.Close SaveChanges:=False
        
        CurFile = Dir
    Loop
    
    Application.DisplayAlerts = False
    DestWB.Sheets(1).Delete
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    Set DestWB = Nothing

   On Error GoTo 0
   Exit Sub

CombineWorkbooks_Error:
Application.DisplayAlerts = True
    Application.EnableEvents = True
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") "
End Sub

Option Explicit 
Public strPath As String 

Public Type BROWSEINFO 
    hOwner As Long 
    pidlRoot As Long 
    pszDisplayName As String 
    lpszTitle As String 
    ulFlags As Long 
    lpfn As Long 
    lParam As Long 
    iImage As Long 
End Type 

'32-bit API declarations 
Declare Function SHGetPathFromIDList Lib "shell32.dll" _ 
                                     Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long 

Declare Function SHBrowseForFolder Lib "shell32.dll" _ 
                                   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long