code error?

Discussion in 'Trading Software' started by Cache Landing, May 11, 2010.

  1. can anyone tell me why this macro might not be working? Trying to use it to consolidate data from multiple workbooks to a single master worksheet.




    Code:
    Option Explicit 
     
     '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 
     
    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 
     
    Function GetDirectory(Optional msg) As String 
        On Error Resume Next 
        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 = "Please select the folder of the excel files to copy." 
        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 CombineFiles() 
        Dim path            As String 
        Dim FileName        As String 
        Dim LastCell        As Range 
        Dim Wkb             As Workbook 
        Dim WS              As Worksheet 
        Dim ThisWB          As String 
         
        ThisWB = ThisWorkbook.Name 
        Application.EnableEvents = False 
        Application.ScreenUpdating = False 
        path = GetDirectory 
        FileName = Dir(path & "\*.xls", vbNormal) 
        Do Until FileName = "" 
            If FileName <> ThisWB Then 
                Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName) 
                For Each WS In Wkb.Worksheets 
                    Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell) 
                    If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then 
                    Else 
                        WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 
                    End If 
                Next WS 
                Wkb.Close False 
            End If 
            FileName = Dir() 
        Loop 
        Application.EnableEvents = True 
        Application.ScreenUpdating = True 
         
        Set Wkb = Nothing 
        Set LastCell = Nothing 
    End Sub
     
  2. when i run the macro, a file path window comes up, but then when I select a folder with a bunch of .xls files, nothing happens.