Run-time error 445

[francolandra]

Dear all

I moved from Excel 2003 to Excel 2010 and now I cannot run macros that I ran using the previous Excel 2003 version.

The message I received when ticking the Macro box in Excel is:

Microsoft Visual Basic
Run-time error '445':
Object doesn't support this action

When I tick the Debug button I receive the next message:

"Sub ImportFXRates()
'
' ImportFXRates Macro
' Macro recorded 22/08/2008 by Andy
'
Dim oldWB As Workbook
Dim newWB As Workbook
Dim ws As Worksheet
Dim cur_Year As String
Dim cur_mon As String
Dim c As Object
Dim i As Integer
Dim flName As String
Dim MonthRef As Integer
Set newWB = ActiveWorkbook
Set ws = ActiveSheet

Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

With ThisWorkbook
cur_Year = .Names!FYREF.RefersToRange.Text
cur_mon = .Names!MONREF.RefersToRange.Text
flName = .Names!FXDir.RefersToRange.Value & "\ER" & Right(cur_Year, 2) & .Names!MONREF.RefersToRange.Text & ".xls"

If FileExists(flName) Then
Application.StatusBar = "Importing " & flName
Workbooks.Open FileName:=flName, UpdateLinks:=0
Set oldWB = ActiveWorkbook

ActiveSheet.Range("A1:D39").Select
Selection.Copy

newWB.Activate


.Activate
.Names("FX").RefersToRange.Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Else
'her error message
End If


oldWB.Close (False)


End With

ws.Activate
Application.StatusBar = ""
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox ("Import Complete")
End Sub
Public Function FileExists(FileName As String) As Boolean
'-------------------------------------------------------------------------
' Author : Philipp Schaefer
' Created : 10-05-2008
' Purpose : Checks if the provided File exists
' Modified :
'-------------------------------------------------------------------------

Dim Pos As Integer

Pos = InStrRev(FileName, "\")

With Application.FileSearch
.NewSearch
.LookIn = Left(FileName, Pos - 1)
.FileName = Mid(FileName, Pos + 1)
.Execute
End With
If Application.FileSearch.FoundFiles.Count = 0 Then
FileExists = False
Else
FileExists = True


End If
End Function"

Could someone help me to fix this error please?

Thank you very much

Franco

 

[xld]

You have to get rid of the FileSearch code, it doesn't exist in Excel 2007.

 

[francolandra]

Ok, so If I understand you properly the final "formula/code" will be the following (Please see the last part)


Microsoft Visual Basic
Run-time error '445':
Object doesn't support this action

When I tick the Debug button I receive the next message:

"Sub ImportFXRates()
'
' ImportFXRates Macro
' Macro recorded 22/08/2008 by Andy
'
Dim oldWB As Workbook
Dim newWB As Workbook
Dim ws As Worksheet
Dim cur_Year As String
Dim cur_mon As String
Dim c As Object
Dim i As Integer
Dim flName As String
Dim MonthRef As Integer
Set newWB = ActiveWorkbook
Set ws = ActiveSheet

Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

With ThisWorkbook
cur_Year = .Names!FYREF.RefersToRange.Text
cur_mon = .Names!MONREF.RefersToRange.Text
flName = .Names!FXDir.RefersToRange.Value & "\ER" & Right(cur_Year, 2) & .Names!MONREF.RefersToRange.Text & ".xls"

If FileExists(flName) Then
Application.StatusBar = "Importing " & flName
Workbooks.Open FileName:=flName, UpdateLinks:=0
Set oldWB = ActiveWorkbook

ActiveSheet.Range("A1:D39").Select
Selection.Copy

newWB.Activate


.Activate
.Names("FX").RefersToRange.Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Else
'her error message
End If


oldWB.Close (False)


End With

ws.Activate
Application.StatusBar = ""
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox ("Import Complete")
End Sub
Public Function FileExists(FileName As String) As Boolean
'-------------------------------------------------------------------------
' Author : Philipp Schaefer
' Created : 10-05-2008
' Purpose : Checks if the provided File exists
' Modified :
'-------------------------------------------------------------------------

Dim Pos As Integer

Pos = InStrRev(FileName, "\")

With Application.FileSearch
.NewSearch
.LookIn = Left(FileName, Pos - 1)
.FileName = Mid(FileName, Pos + 1)
.Execute
End With
If Application.FileSearch.FoundFiles.Count = 0 Then
Dir(FileName) <> "" = False
Else
Dir(FileName) <> "" = True

End If
End Function"

 

[francolandra]

Hi

One question, how much would you charge to fix this problem for me? If you cannot do it, perhaps you could reccommend a person that can.

Thanks

 

[xld]

Send me your workbook and I will take a look.

 

[francolandra]

Thank you. Could you send me your e-mail address to send you the file? Mine is franco_landra@idg.com

Thanks

Franco

 

[SOLLIJONES]

Hello Community,

We are also experiencing an issue with a PeopleSoft nVision macro that was probably carried over from Excel 2003. Our nVision environment is now using Excel 2007. However, many users have Excel 2010 or 2016 installed on their computers. The macro is used to format PS nVision layouts that are basically Excel files. The style sheets are saved under a specific directory that is setup under the configuration for nVision in the PeopleSoft Application Designer application.

I have a very limited understanding of VBA and would greatly appreciate some guidance.

The run-time error 445 is first generated when the macro to Open Style Sheets is selected. When debug is selected, the "Unload StyleTypes" line is highlighted -
'******************************************************************
' Activates the Style Sheet creation wizard
'******************************************************************
Sub OpenStyleSheets()
Unload StyleTypes
StyleTypes.Show
End Sub

After additional research, it was discovered that FileSearch is usually the cause of this run-time error. When the code was searched for FileSearch, the following code was found -

' ******************************************************************
' Retrieves all valid Style sheets.
' ******************************************************************
Sub GetStyleTypes()
Dim Dirlen As Integer
Dim f, f1, fc, s
Dim iFileCount As Integer
Dim strTemp As String
iFileCount = 0
GetDirectory
Set fs = Application.FileSearch
With fs
.LookIn = Directory
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
iFileCount = .FoundFiles.Count
For i = 1 To iFileCount

Dirlen = Len(.LookIn) + 2
strTemp = Mid(.FoundFiles(i), Dirlen)
StyleBox.AddItem (strTemp)
Next i
End If
End With
If iFileCount = 0 Then
Set fs = Nothing
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(Directory)
Set fc = f.Files

For Each f1 In fc
If UCase(Right((f1.Name), 4)) = ".XLS" Then
iFileCount = iFileCount + 1
Dirlen = Len(Directory) + 2
strTemp = f1.Name
StyleBox.AddItem (strTemp)
End If
Next
End If

cleanup:
Set fs = Nothing
Set f = Nothing
Set fc = Nothing

End Sub