With Application.FileSearch - Runtime error '445': Object doesn't support this action

[Hooley17]

Hi all - Would some kind soul please put me out of my misery - worked in XL2003 - but not in XL2010. Have searched forum, but need someone to amend my specific bit of inherited code. Cheers !

    'RECORDED FROM A CSV FILE SAVED TO XL
    'ChDir "C:\Users\Mark\Desktop"
    'ActiveWorkbook.SaveAs Filename:="C:\Users\Mark\Desktop\test.xls", FileFormat _
        ':=xlExcel9795, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
        'False, CreateBackup:=False
    
    With Application.FileSearch
        .LookIn = CSVPath
        .Filename = "*.csv"
        .Execute
        
        For CSVCount = 1 To .FoundFiles.Count
            Set wb = Application.Workbooks.Open(.FoundFiles(CSVCount))
            'wb.SaveAs CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls", xlXMLSpreadsheet
            wb.SaveAs CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls", xlExcel9795

 

[RoryA]

Filesearch was deprecated with Excel 2007 but you can use Dir instead - something like:

    Dim strFile As String
    strFile = Dir(CSVPath & "*.csv")
    Do While strFile <> vbNullString

        Set wb = Application.Workbooks.Open(CSVPath & strFile)
        'wb.SaveAs CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls", xlXMLSpreadsheet
        wb.SaveAs CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls", xlExcel9795
        wb.Close False
        strFile = Dir()
    Loop

 

[Hooley17]

Great - almost there, but now I have a Compile error - here's the code in full. It's just some VBA to convert files from CSV to XLS to enable me to import them into ACCESS 2000

Option Explicit
Sub CSVtoXLS()
Dim wb As Workbook
Dim CSVPath As String
Dim CSVCount As Integer
    
    'CSVPath = "[URL="file://\\DFZ7***.link2.gpn.***.uk\10014699$\"]\\DFZ7***.link2.gpn.***.uk\10014699$\[/URL]"
    'CSVPath = "d:\BT\"
    
    CSVPath = InputBox("Type the full path (eg. c:\data\...")
    
    
    'RECORDED FROM A CSV FILE SAVED TO XL
    'ChDir "C:\Users\Mark\Desktop"
    'ActiveWorkbook.SaveAs Filename:="C:\Users\Mark\Desktop\test.xls", FileFormat _
        ':=xlExcel9795, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
        'False, CreateBackup:=False
    
  Dim strFile As String
    strFile = Dir(CSVPath & "*.csv")
    Do While strFile <> vbNullString
        Set wb = Application.Workbooks.Open(CSVPath & strFile)
        'wb.SaveAs CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls", xlXMLSpreadsheet
        wb.SaveAs CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls", xlExcel9795
        wb.Close False
        strFile = Dir()
    Loop
                
            
            Range("A1").Select
    If ActiveCell = "TARIFFTYPE" Then
    Range("A1").Select
    wb.Save
    wb.Close
    
    Else
    
    Selection.EntireRow.Insert
    ActiveCell.FormulaR1C1 = "TARIFFTYPE"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "ORIGINATINGNUMBER"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "RECEIVINGNUMBER"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "DURATION"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "TIMEOFCALL"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "TIMEBAND"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "CALLDATE"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "COSTOFCALL"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "DISTANCEBAND"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "SLOC"
    Range("A1").Select
    wb.Save
    wb.Close
    End If
    Next
         
         'MsgBox (CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls" & " - DONE")
    End With
End Sub

 

[RoryA]

Always better to post the full code.

Try this:

Sub CSVtoXLS()
    Dim wb                    As Workbook
    Dim CSVPath               As String
    Dim CSVCount              As Integer
    Dim strFile               As String

    'CSVPath = "\\DFZ7***.link2.gpn.***.uk\10014699$\"
    'CSVPath = "d:\BT\"

    CSVPath = InputBox("Type the full path (eg. c:\data\...")


    'RECORDED FROM A CSV FILE SAVED TO XL
    'ChDir "C:\Users\Mark\Desktop"
    'ActiveWorkbook.SaveAs Filename:="C:\Users\Mark\Desktop\test.xls", FileFormat _
     ':=xlExcel9795, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
     'False, CreateBackup:=False

    strFile = Dir(CSVPath & "*.csv")
    Do While strFile <> vbNullString
        Set wb = Application.Workbooks.Open(CSVPath & strFile)
        'wb.SaveAs CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls", xlXMLSpreadsheet
        wb.SaveAs CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls", xlExcel9795

        If Range("A1").Value <> "TARIFFTYPE" Then
            Rows(1).Insert
            Range("A1:J1").Value = Array("TARIFFTYPE", "ORIGINATINGNUMBER", "RECEIVINGNUMBER", _
                                         "DURATION", "TIMEOFCALL", "TIMEBAND", "CALLDATE", _
                                         "COSTOFCALL", "DISTANCEBAND", "SLOC")
            wb.Save
        End If
        wb.Close False
        strFile = Dir()
    Loop

    'MsgBox (CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls" & " - DONE")
End Sub

 

[Hooley17]

Rory - greatly apreciate your help - one error still showing -

Run-time error '1004':
Method 'SaveAs' of object ' _Workbook' failed.

Sub CSVtoXLS()
    Dim wb                    As Workbook
    Dim CSVPath               As String
    Dim CSVCount              As Integer
    Dim strFile               As String
    'CSVPath = "[URL="file://\\DFZ7***.link2.gpn.***.uk\10014699$\"]\\DFZ7***.link2.gpn.***.uk\10014699$\[/URL]"
    'CSVPath = "d:\BT\"
    CSVPath = InputBox("Type the full path (eg. c:\data\...")

    'RECORDED FROM A CSV FILE SAVED TO XL
    'ChDir "C:\Users\Mark\Desktop"
    'ActiveWorkbook.SaveAs Filename:="C:\Users\Mark\Desktop\test.xls", FileFormat _
     ':=xlExcel9795, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
     'False, CreateBackup:=False
    strFile = Dir(CSVPath & "*.csv")
    Do While strFile <> vbNullString
        Set wb = Application.Workbooks.Open(CSVPath & strFile)
        'wb.SaveAs CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls", xlXMLSpreadsheet
[COLOR=#FF0000]        wb.SaveAs CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls", xlExcel9795[/COLOR]
        If Range("A1").Value <> "TARIFFTYPE" Then
            Rows(1).Insert
            Range("A1:J1").Value = Array("TARIFFTYPE", "ORIGINATINGNUMBER", "RECEIVINGNUMBER", _
                                         "DURATION", "TIMEOFCALL", "TIMEBAND", "CALLDATE", _
                                         "COSTOFCALL", "DISTANCEBAND", "SLOC")
            wb.Save
        End If
        wb.Close False
        strFile = Dir()
    Loop
    'MsgBox (CSVPath & Left(wb.Name, Len(wb.Name) - 4) & ".xls" & " - DONE")
End Sub

 

[RoryA]

Do you have Excel set to block saving as Excel95-97 format in Trust Center? (is there a reason for using that rather than xlExcel8?)

 

[Hooley17]

I swapped xlExcel9795 to xlExcel8 and it works a treat

Brilliant - Many thanks..