VBA Application.Filesearch workaround

[eeder1]

I REALLY need a fix for the application.filesearch function that is currently in some old code which works in Excel 2003 and before but not in Excel 2007. I have heard suggestions on fixing this by using the Dir function but with my limited knowledge and no time I need expertise...PLEASE HELP!!!!



Call GetBrowse 'goes to a sub that allows you to pick a file with multiple excel files...after running through it jumps back to the Application.Filesearch below and gets stuck due to it being removed from 2007
With Application.FileSearch
.NewSearch
.LookIn = strPath
.Filename = "*.xls"
If .Execute() > 0 Then
Workbooks.Add
WrWrkBk = ActiveWorkbook.Name
x = Workbooks(WrWrkBk).Worksheets.Count

sort = 8
For i = 1 To counter - 1
Application.ScreenUpdating = False
strfile = .FoundFiles(i)


Find_Last_Slash (strfile)
strfile = Mid(strfile, 1, position)
a = a + 1
strDiv = Workbooks(RdWrkBk1).Sheets(1).Cells(a, sort).Value
strfile = strfile & strDiv & ".xls"

Workbooks.Open strfile 'open workbook

Find_Last_Slash (strfile)
RdWrkBk = Trim(Mid(strfile, position + 1, 50))

 

[jindon]

Ok that copy paste specials the data (loses the coloring but least of my worries) It still only grabs one file data and then stops. this time the update link did not pop up ..Still need to name worksheet and grab multiple files..any more thoughts? Once again much appreciated

1) That shouldn't.

2) Are you sure that the file name starts from H7 ?

Set rng = .Range("h7", .Range("h" & Rows.Count).End(xlUp))

Above part should catch the range that is from H7 to the last entered cell.
If it stops after the first file, that means H7 the starting cell and also the last cell in col.H

 

[eeder1]

1) That shouldn't.

Yeah, not sure why it is but it is.

2) Are you sure that the file name starts from H7 ?

Positive it starts in "H7"

Set rng = .Range("h7", .Range("h" & Rows.Count).End(xlUp))

Above part should catch the range that is from H7 to the last entered cell.
If it stops after the first file, that means H7 the starting cell and also the last cell in col.H

I am getting a run time error 1004 on the last piece of code that must be stopping it from moving to the next file??

End If
    wb.Sheets(n).Name = r.value & " - Unit Waterfalls"
Next 
End Sub

 

[jindon]

What was the error description ?

 

[eeder1]

Run Time error '1004':
Application -Defined or Object defined error

 

[jindon]

Can you change

For Each r In rng
    fn = Dir(myFolder & r.Value & ".xls", vbNormal)
    If fn = "" Then
        MsgBox "No such file named " & r.Value & ".xls in " & myFolder
    Else
        n = n + 1
        If n > wb.Sheets.Count Then wb.Sheets.Add after:=wb.Sheets(n-1)
        With Workbooks.Open(myFolder & fn)
            .Sheets(mySheet).Range(myRange).Copy
            wb.Sheets(n).Cells(1).PasteSpecial
            wb.Sheets(n).Cells.Value = wb.Sheets(n).Cells.Value
            Application.CutCopyMode = False
            .Close False
        End With
    End If
    wb.Sheets(n).Name = r.Value & " - Unit Waterfalls"
Next

to

For Each r In rng
    fn = Dir(myFolder & r.Value & ".xls", vbNormal)
    If fn = "" Then
        MsgBox "No such file named " & r.Value & ".xls in " & myFolder
    Else
        n = n + 1
        If n > wb.Sheets.Count Then wb.Sheets.Add after:=wb.Sheets(n-1)
        With Workbooks.Open(myFolder & fn)
            .Sheets(mySheet).Range(myRange).Copy wb.Sheets(n).Cells(1)
            wb.Sheets(n).Cells.Value = wb.Sheets(n).Cells.Value
            Application.CutCopyMode = False
            .Close False
        End With
        On Error Resume Next
        wb.Sheets(n).Name = r.Value & " - Unit Waterfalls"
        If Err <> 0 Then
            MsgBox r.Value & " - Unit Waterfalls can't be a sheet name"
        End If
        On Error GoTo 0
    End If
Next

 

[eeder1]

Awesome it went through named the worksheets did multiple files!!!
Two questions...
1) is there somehting that can be done for File names that are really long...for example if the file name is and "Unit waterfalls" is too many characters for the worksheet name? Before I would put the name in the column next to the list in colum "I"
2) What if I need to grab two or three worksheets from multiple files.
Worksheet names all the same "Unit Waterfalls" , "sales" and "revenues"?

 

[jindon]

1)
I thought the length of the file name including the path for Windows is 255 bytes.
The max length of the worksheet is 31 characters

Both have special characters that can not be used.
You can get them from the web...

2)

Sub test()
Dim myFolder As String, fn As String, wb As Workbook, n As Long
Dim mySheet, myRange As String, r As Range, rng As Range, e
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = True Then
        myFolder = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With
myFolder = myFolder & "\"
mySheet = Array("Unit Waterfalls","sales", "revenues")
myRange = "A1:Z100"
Set wb = Workbooks.Add
With ThisWorkbook.Sheets(1)
    Set rng = .Range("h7", .Range("h" & Rows.Count).End(xlUp))
End With
For Each r In rng
    fn = Dir(myFolder & r.Value & ".xls", vbNormal)
    If fn = "" Then
        MsgBox "No such file named " & r.Value & ".xls in " & myFolder
    Else
        With Workbooks.Open(myFolder & fn)
            For Each e In mySheet
                n = n + 1
                If n > wb.Sheets.Count Then wb.Sheets.Add after:=wb.Sheets(n-1)
                .Sheets(e).Range(myRange).Copy wb.Sheets(n).Cells(1)
                wb.Sheets(n).Cells.Value = wb.Sheets(n).Cells.Value
                Application.CutCopyMode = False
                On Error Resume Next
                wb.Sheets(n).Name = r.Value & " - " & e
                If Err <> 0 Then
                    MsgBox r.Value & " - " & e & " can't be used for a sheet name"
                End If
                On Error GoTo 0
            Next
            .Close False
        End With
    End If
Next
End Sub

 

[eeder1]

Is there a way for it to continue through links when it ask it for it? When the files have links it stops at the following code for you to continue

With Workbooks.Open(myFolder & fn)

 

[jindon]

try

With Workbooks.Open(myFolder & fn, updatelinks = false)

 

[eeder1]

Hmm it still asks..