Solved: Excel 2003 Macro Doesn't Run in Excel 2007 - Help Requested

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

jaweiss

Thread Starter
Joined
Apr 15, 2011
Messages
3
I’m using Windows 7 and I used a macro which worked totally fine under Excel 2003. Now, under Excel 2007 it does not run anymore but displays the following error message:

"Run-time error '445':
Object doesn't support this action.

The function of the macro is to open up all other Excel spreadsheets located in the same folder and copy data out of them into the spreadsheet in which the macro is stored.

When I click on "Debug" the Visual Basic Editor highlights the row which says: Set FilSrch = Application.FileSearch

Can you help me with this? I've searched for a solution for a long time but could not find anything which worked.

The following is the start of the macro code:

Sub UpdateTable()
Dim X As Range, I As Integer, J As Integer, RecNo As Integer, CopyVal As Variant
Dim SourceBk As Worksheet, DestBk As Worksheet, StartRow As Integer, IndRange As Range
Dim ServRange As Range, SrcOpen As Boolean, SourceName As String
Dim FilSrch As Object, MyFilArray() As String

'MsgBox "This function not available in this version.", vbInformation, "Function Not Available"
'Exit Sub
'Sheets("LookUp").[a12] = Now
With Application
.ScreenUpdating = False
.StatusBar = "Counting source files ..."
End With
Set FilSrch = Application.FileSearch
With FilSrch
.NewSearch
.LookIn = ActiveWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
ReDim MyFilArray(.FoundFiles.Count)
For I = 1 To .FoundFiles.Count
If .FoundFiles(I) <> ActiveWorkbook.Path & "\" & ActiveWorkbook.Name Then
MyFilArray(I) = .FoundFiles(I)
End If
Next I
Else
MsgBox "There were no files found."
End If
End With
 
Joined
Jul 28, 2006
Messages
1,223
Hi

Application.FileSearch is no longer supported in Office 2007.
As an alternative, try this code:
Code:
Sub UpdateTable_Mod()
    Dim FN As String, MyFilArray() As String
    
    ReDim MyFilArray(0)
    FN = Dir(ActiveWorkbook.Path & "\*.xls*", vbNormal)
    While Not FN = ""
        If FN <> ActiveWorkbook.Name Then
            ReDim Preserve MyFilArray(UBound(MyFilArray) + 1)
            MyFilArray(I) = ActiveWorkbook.Path & "\" & FN
        End If
        FN = Dir()
    Wend
End Sub
It does roughly the same as your original code, except giving feedback on the statusbar, or if no files were found.
Also, I deleted all those useless variables.

Jimmy
 

jaweiss

Thread Starter
Joined
Apr 15, 2011
Messages
3
Hi Jimmy

Thank you very much for suggesting this alternative code. This was very helpful. I've integrated it into the macro. I do not get the error message I used to get but now there is another issue. In the next step, the macro used to open up all xls files in the same directory and copy data out of them into the Master.xls file in which the macro was run.

Now, it does not open up these files anymore. I noticed that the issue must be with the statement:
If MyFilArray(J) <> "" Then

It seems that the macro skips the entire bit after the Then and directly proceeds to End If.

I've spend several hours now trying to fix this but wasn't successful. Are you able to help?

This is the full macro code:

Code:
Sub UpdateTable_Mod()
    Dim X As Range, I As Integer, J As Integer, RecNo As Integer, CopyVal As Variant
    Dim SourceBk As Worksheet, DestBk As Worksheet, StartRow As Integer, IndRange As Range
    Dim ServRange As Range, SrcOpen As Boolean, SourceName As String
    Dim FN As String, MyFilArray() As String
        
    ReDim MyFilArray(0)
    FN = Dir(ActiveWorkbook.Path & "\*.xls*", vbNormal)
    While Not FN = ""
        If FN <> ActiveWorkbook.Name Then
            ReDim Preserve MyFilArray(UBound(MyFilArray) + 1)
            MyFilArray(I) = ActiveWorkbook.Path & "\" & FN
        End If
        FN = Dir()
    Wend
For J = 1 To UBound(MyFilArray)
    Application.StatusBar = "Appending workbook " & J - 1 & " of " & UBound(MyFilArray) - 1 & " ..."
    [B]If MyFilArray(J) <> "" Then[/B]        
        SourceName = MyFilArray(J)
        Workbooks.Open SourceName
        
        Set SourceBk = ActiveWorkbook.Sheets("Source")
        Set DestBk = Workbooks("Master.xls").Sheets("Data")
        RecNo = DestBk.Range("Data").CurrentRegion.Rows.Count
        CopyVal = SourceBk.Range("Owner").Value
        DestBk.Range("Owner").Resize(9, 1).Offset(RecNo, 0).FormulaArray = CopyVal
        CopyVal = SourceBk.Range("Period").Value
        DestBk.Range("Period").Resize(9, 1).Offset(RecNo, 0).FormulaArray = CopyVal
        CopyVal = SourceBk.Range("Region").Value
        DestBk.Range("Region").Resize(9, 1).Offset(RecNo, 0).FormulaArray = CopyVal
        CopyVal = SourceBk.Range("Prep").Value
        DestBk.Range("Prep").Resize(9, 1).Offset(RecNo, 0).FormulaArray = CopyVal
        CopyVal = SourceBk.Range("CurDate").Value
        DestBk.Range("CurDate").Resize(9, 1).Offset(RecNo, 0).FormulaArray = CopyVal
        For I = 1 To 4
            CopyVal = SourceBk.Range("Period").Value & SourceBk.Range("Region").Value _
                & SourceBk.Range("sawlogs").Cells(I, 1)
            DestBk.Range("PeriodRegion").Offset(RecNo + I - 1, 0) = CopyVal
        Next
        For I = 1 To 5
            CopyVal = SourceBk.Range("Period").Value & SourceBk.Range("Region").Value _
                & SourceBk.Range("othlogs").Cells(I, 1)
            DestBk.Range("PeriodRegion").Offset(RecNo + I + 3, 0) = CopyVal
        Next
        CopyVal = SourceBk.Range("Tel").Value
        DestBk.Range("Tel").Resize(9, 1).Offset(RecNo, 0).FormulaArray = CopyVal
        SourceBk.Range("SawLogs").Copy
        DestBk.Range("Logs").Offset(RecNo, 0).PasteSpecial xlPasteValues
        SourceBk.Range("OthLogs").Copy
        DestBk.Range("Logs").Offset(RecNo + 4, 0).PasteSpecial xlPasteValues
        SourceBk.Activate
        ActiveWorkbook.Close False
    End If
Next J

With Application
    .Goto Workbooks("Master.xls").Sheets("Master").Range("A1"), True
    .StatusBar = False
    .ScreenUpdating = True
End With

End Sub
 
Joined
Jul 28, 2006
Messages
1,223
Ooops... :eek:
That was a huge overseeing from my part. The problem is that MyFilArray is, in fact, almost empty after scanning the folder, because variable I is not increased.
This is the wrong code:
Code:
    While Not FN = ""
        If FN <> ActiveWorkbook.Name Then
            ReDim Preserve MyFilArray(UBound(MyFilArray) + 1)
            MyFilArray(I) = ActiveWorkbook.Path & "\" & FN
        End If
        FN = Dir()
    Wend
As you can see, during the looping, variable I remains a constant value, which is zero in this case.
So MyFilArray(0) is overwritten again and again. Also, later in the code, processing of MyFilArray begins with the 1st element (MyFilArray(1)), thus, while MyFilArray(0) is a valid xls path, even that file will not be processed.

Here's the corrected code:
Code:
    While Not FN = ""
        If FN <> ActiveWorkbook.Name Then
            ReDim Preserve MyFilArray(UBound(MyFilArray) + 1)
            MyFilArray(UBound(MyFilArray)) = ActiveWorkbook.Path & "\" & FN
        End If
        FN = Dir()
    Wend
Jimmy
 

jaweiss

Thread Starter
Joined
Apr 15, 2011
Messages
3
Thank you so much, Jimmy! Now it works! Fantastic! You can't imagine how happy I am :)
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Members online

Top