Code to choose directory works in Xp, not in 7

[3chords]

Hi,

My code is designed to allow the user to browse to and designate a folder, open up all the excel files in that folder and then consolidate all the data within the excel files. I am using XP and the code works perfectly. On 7 it doesn't work. The folder shows up as empty. I had the user unhide the file extensions but that didn't work. Thanks in advance.

-3chords



Sub Combine()

'This opens up the workbooks, copies the data, and consolidates it into 1 sheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Consolidate").Cells.Clear
LastCol = "O"

folder = GetFolder()
folder = folder & "\"
FName = Dir(folder & "*.xl*")

With ThisWorkbook.Sheets("Consolidate")
.Cells.ClearContents
Do While FName <> ""
Set bk = Workbooks.Open(Filename:=folder & FName)
For Each sht In bk.Sheets

ThisbookLastRow = .Range("A" & Rows.Count).End(xlUp).Row
If ThisbookLastRow = 1 Then
NewRow = 1
'copy header row
sht.Range("A1:" & LastCol & "1").Copy _
Destination:=.Range("B1")
'put filename in cell A1
sht.Range("A1") = "Workbook"
End If
NewRow = ThisbookLastRow + 1


With sht
lastrow = .Range("A" & Rows.Count).End(xlUp).Row
DataRows = lastrow - 1
Set CopyRange = .Range("A2:" & LastCol & lastrow)
End With

'copy data from old workbook to this workbook
If DataRows > 0 Then
CopyRange.Copy _
Destination:=.Range("B" & NewRow)
'put book name into column A
.Range("A" & NewRow & ":A" & (NewRow + DataRows - 1)) = _
FName
End If
Next sht
bk.Close savechanges:=False
FName = Dir()
Loop
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub


Function BrowseForFolder(Optional OpenAt As Variant) As Variant

Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
frmGUI.txtFoundFolder.Text = BrowseForFolder
On Error GoTo 0

Set ShellApp = Nothing

Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select

Exit Function

Invalid:
BrowseForFolder = False

End Function