locked
Need help with replacing application.filesearch RRS feed

  • Question

  • So im working in access 2010 and need to replace application.filesearch, knowing next to nothing in VBA I was hpoing someone could help me with this as well as educate me a bit about what was changed and how to replace.

    Function ImportExcelFiles()
    Dim Counter As Integer

    With Application.FileSearch
    .NewSearch
    .LookIn = "C:\Documents and Settings\jaguest.JARMI\Desktop\{Excel Temps}{Excel Data}" 'change this to your actual directory
    .SearchSubFolders = True 'set to True if you want to search subfolders too
    FileName = "*.xls" 'changed HERE

    If .Execute() > 0 Then 'files found
    For Counter = 1 To .FoundFiles.Count 'loop through files
    .FileName = .FoundFiles(Counter) 'set / get the file name
    'Change the "ImportFile" part in the line below if you are using a different table name
    'Note: 1 command for each worksheet. I have assumed they are Sheet1 etc.
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, False, "Sheet1!" 'Changed HERE
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, False, "Sheet1!" 'Changed HERE
    'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, True, "Sheet1!"'Changed HERE

    DoEvents 'don't take over all of the PC resources
    Next Counter
    MsgBox "Import complete.", vbInformation, "Done"
    Else 'files not found
    MsgBox "There were no files found.", vbCritical, "Error"
    End If
    End With
    End Function

    Tuesday, April 2, 2013 7:52 PM

Answers

  • The FileSearch object was discontinued in Office 2007. Instead, I suggest you to use the FileSystemObject object:

    Dim mfso As Object 'Scripting.FileSystemObject
    
    Sub fMain()
        
        'Change this to your directory
        Const strCaminho As String = "C:\yourfolder"
        
        Dim fld As Object 'Scripting.Folder
        
        Set mfso = CreateObject("Scripting.FileSystemObject")
        Set fld = mfso.GetFolder(strCaminho)
        
        fRecurFolder fld
        
        MsgBox "Import complete.", vbInformation, "Done"
        
        Set mfso = Nothing
    End Sub
    
    Private Sub fRecurFolder(fld As Object) 'fld As Scripting.Folder
        Dim fldSubFolder As Object 'Scripting.Folder
        Dim fle As Object 'Scripting.File
        
        'Lista all files of this folder
        For Each fle In fld.Files
            'Only xls files:
            If LCase(mfso.GetExtensionName(fle)) = "xls" Then
                'Put your code here:
                DoCmd.TransferSpreadsheet acImport _
                , acSpreadsheetTypeExcel8 _
                , "Table1" _
                , fle _
                , False _
                , "Sheet1!"
            End If
        Next fle
        
        'Recur all subfolders of a folder
        For Each fldSubFolder In fld.SubFolders
            fRecurFolder fldSubFolder
        Next fldSubFolder
        
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marked as answer by Dummy yoyo Monday, April 8, 2013 9:37 AM
    Tuesday, April 2, 2013 9:05 PM
  • You could also use the following

    Sub ImportExcelFiles()
    Dim strFileName As String
    Dim strPath As String
    Dim oWB As Workbook
    Dim fDialog As FileDialog
        Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

        With fDialog
            .Title = "Select folder and click OK"
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewList
            If .Show <> -1 Then
                MsgBox "Cancelled By User", , _
                       "List Folder Contents"
                Exit Sub
            End If
            strPath = fDialog.SelectedItems.Item(1) & "\"
        End With
        strFileName = Dir$(strPath & "*.xls")
        While Len(strFileName) <> 0
            Set oWB = Workbooks.Open(strPath & strFileName)

            'Do what you want with the open workbook 'oWB' here e.g.
            MsgBox oWB.Name & " open."

            oWB.Close SaveChanges:=False        'True
        Wend
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com

    • Marked as answer by Dummy yoyo Monday, April 8, 2013 9:37 AM
    Wednesday, April 3, 2013 5:00 AM

All replies

  • The FileSearch object was discontinued in Office 2007. Instead, I suggest you to use the FileSystemObject object:

    Dim mfso As Object 'Scripting.FileSystemObject
    
    Sub fMain()
        
        'Change this to your directory
        Const strCaminho As String = "C:\yourfolder"
        
        Dim fld As Object 'Scripting.Folder
        
        Set mfso = CreateObject("Scripting.FileSystemObject")
        Set fld = mfso.GetFolder(strCaminho)
        
        fRecurFolder fld
        
        MsgBox "Import complete.", vbInformation, "Done"
        
        Set mfso = Nothing
    End Sub
    
    Private Sub fRecurFolder(fld As Object) 'fld As Scripting.Folder
        Dim fldSubFolder As Object 'Scripting.Folder
        Dim fle As Object 'Scripting.File
        
        'Lista all files of this folder
        For Each fle In fld.Files
            'Only xls files:
            If LCase(mfso.GetExtensionName(fle)) = "xls" Then
                'Put your code here:
                DoCmd.TransferSpreadsheet acImport _
                , acSpreadsheetTypeExcel8 _
                , "Table1" _
                , fle _
                , False _
                , "Sheet1!"
            End If
        Next fle
        
        'Recur all subfolders of a folder
        For Each fldSubFolder In fld.SubFolders
            fRecurFolder fldSubFolder
        Next fldSubFolder
        
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marked as answer by Dummy yoyo Monday, April 8, 2013 9:37 AM
    Tuesday, April 2, 2013 9:05 PM
  • You could also use the following

    Sub ImportExcelFiles()
    Dim strFileName As String
    Dim strPath As String
    Dim oWB As Workbook
    Dim fDialog As FileDialog
        Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

        With fDialog
            .Title = "Select folder and click OK"
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewList
            If .Show <> -1 Then
                MsgBox "Cancelled By User", , _
                       "List Folder Contents"
                Exit Sub
            End If
            strPath = fDialog.SelectedItems.Item(1) & "\"
        End With
        strFileName = Dir$(strPath & "*.xls")
        While Len(strFileName) <> 0
            Set oWB = Workbooks.Open(strPath & strFileName)

            'Do what you want with the open workbook 'oWB' here e.g.
            MsgBox oWB.Name & " open."

            oWB.Close SaveChanges:=False        'True
        Wend
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com

    • Marked as answer by Dummy yoyo Monday, April 8, 2013 9:37 AM
    Wednesday, April 3, 2013 5:00 AM