none
Run time error 445 because of Application.FileSearch RRS feed

  • Question

  • Hi,

    I was provided a vba script that works well on excel 2003 but when I run it on my own 2007 I receive a "Run time error 445" error message. I understand it's because of the Application.FileSearch being used, but I'm don't understand it enough to know where to make the changes.

    It's been programmed to traverse through a folder of text files and extract the file names and then the contents, and place them in a cell, move onto the next file and place that into the next row. and so on.

    I would appreciate any help on this. My code looks like the following:

    Sub RunCodeOnAllTextFiles()
    Dim lCount As Long
    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\KnowledgeStuff"
        .Filename = "*.txt"
        If .Execute() > 0 Then
                For i = 1 To .FoundFiles.Count
            ImportTextFile FName:=.FoundFiles(i), Sep:="|?????"
            ActiveCell.Offset(1, 0).Select
        Next i
        End If
    End With
    End Sub
    Sub ImportTextFile(FName As String, Sep As String)
    Dim RowNdx As Long
    Dim ColNdx As Integer
    Dim TempVal As Variant
    Dim WholeLine As String
    Dim Pos As Integer
    Dim NextPos As Integer
    Dim SaveColNdx As Integer

    Application.ScreenUpdating = False
    'On Error GoTo EndMacro:

    SaveColNdx = ActiveCell.Column
    RowNdx = ActiveCell.Row

    Open FName For Input Access Read As #1

    While Not EOF(1)
        Line Input #1, WholeLine
        If Right(WholeLine, 1) <> Sep Then
            WholeLine = WholeLine & Sep
        End If
        ColNdx = SaveColNdx
        Pos = 1
        NextPos = InStr(Pos, WholeLine, Sep)
        While NextPos >= 1
            TempVal = Mid(WholeLine, Pos, NextPos - Pos)
            Cells(RowNdx, ColNdx).Value = TempVal
            Pos = NextPos + 1
            ColNdx = ColNdx + 1
            NextPos = InStr(Pos, WholeLine, Sep)
        Wend
        RowNdx = RowNdx + 1
    Wend

    EndMacro:
    On Error GoTo 0
    Application.ScreenUpdating = True
    Close #1
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' END ImportTextFile
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    End Sub
    Sunday, October 12, 2014 11:36 PM

Answers

  • Re:  FileSearch no longer functions

    The FileSearch function was troublesome at times and (for me) hard to understand.
    You can replace the "RunCodeOnAllTextFiles" with the following code.
    The "ImportTextFile" code doesn't appear to need changing.
    '---

    Sub RunCodeOnAllTextFiles_R1()
        Dim strPath As String
        Dim oFSO    As Object
        Dim oFile   As Object
        Dim oFolder As Object
        
        strPath = "C:\KnowledgeStuff"
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set oFolder = oFSO.GetFolder(strPath)
        
        For Each oFile In oFolder.Files
          If oFile.Name Like "*.txt" Then
            ImportTextFile FName:=oFile.Path, Sep:="|?????"
          End If
        Next 'oFile
        
        Set oFSO = Nothing
        Set oFile = Nothing
        Set oFolder = Nothing
    End Sub
    '---

    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    Monday, October 13, 2014 1:11 AM
  • Re:  Everything in the same place

    For some reason, I omitted a line of code from your original.
    Add this line back in... "ActiveCell.Offset(1, 0).Select" so the code looks like:

      For Each oFile In oFolder.Files
          If oFile.Name Like "*.txt" Then
            ImportTextFile FName:=oFile.Path, Sep:="|?????"
            ActiveCell.Offset(1, 0).Select
          End If
      Next 'oFile
    '---
    Jim Cone


    Monday, October 13, 2014 2:49 PM

All replies

  • Re:  FileSearch no longer functions

    The FileSearch function was troublesome at times and (for me) hard to understand.
    You can replace the "RunCodeOnAllTextFiles" with the following code.
    The "ImportTextFile" code doesn't appear to need changing.
    '---

    Sub RunCodeOnAllTextFiles_R1()
        Dim strPath As String
        Dim oFSO    As Object
        Dim oFile   As Object
        Dim oFolder As Object
        
        strPath = "C:\KnowledgeStuff"
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set oFolder = oFSO.GetFolder(strPath)
        
        For Each oFile In oFolder.Files
          If oFile.Name Like "*.txt" Then
            ImportTextFile FName:=oFile.Path, Sep:="|?????"
          End If
        Next 'oFile
        
        Set oFSO = Nothing
        Set oFile = Nothing
        Set oFolder = Nothing
    End Sub
    '---

    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    Monday, October 13, 2014 1:11 AM
  • Thank you for this Jim,

    I've just replaced the code with yours and it appears to work differently now.

    It places each line in it's own cell and only for the last file in the folder. Is there something wrong with the 'ImportTextFile' code?

    Monday, October 13, 2014 6:01 AM
  • Re:  Everything in the same place

    For some reason, I omitted a line of code from your original.
    Add this line back in... "ActiveCell.Offset(1, 0).Select" so the code looks like:

      For Each oFile In oFolder.Files
          If oFile.Name Like "*.txt" Then
            ImportTextFile FName:=oFile.Path, Sep:="|?????"
            ActiveCell.Offset(1, 0).Select
          End If
      Next 'oFile
    '---
    Jim Cone


    Monday, October 13, 2014 2:49 PM