1.

Does the specified file exist?

Does the specified file exist?

Function FileExists(stFile As String) As Boolean

If Dir(stFile) <> "" Then FileExists = True

End Function

Sub TestForFile()

Dim myFileName As String

myFileName = "c:\SalesData1.xls"

If FileExists(myFileName) Then

MsgBox myFileName & " exists"

Else

MsgBox myFileName & " does not exist"

End If

End Sub

2.

Check file existance

Sub ReadPersistedRecordset()

    Dim strFileName As String

    strFileName = "c:\test.txt"

    If Len(Dir(strFileName)) = 0 Then

        msgBox "File Not Found"

        Exit Sub

    End If

End Sub

3.

Gets the file name from the path.

Sub GetFileName()

   Dim stPathSep As String

   Dim fileLength As Integer

   Dim i As Integer

   Dim stFullName As String

   stFullName = "C:\asdf.xls"

   stPathSep = Application.PathSeparator

   fileLength = Len(stFullName)

   For i = fileLength To 1 Step -1

      If Mid(stFullName, i, 1) = stPathSep Then Exit For

         Debug.Print Right(stFullName, fileLength - i + 1)

   Next i

End Sub

4.

List all files under application path

Sub FileList()

  Dim File As Variant

  With Application.FileSearch

    .LookIn = "C:\"

    .FileType = msoFileTypeAllFiles

    .Execute

    For Each File In .FoundFiles

      MsgBox File

    Next File

  End With

End Sub

5.

Select a folder

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Type BROWSEINFO

    hOwner As Long

    pidlRoot As Long

    pszDisplayName As String

    lpszTitle As String

    ulFlags As Long

    lpfn As Long

    lParam As Long

    iImage As Long

End Type

Function GetDirectory() As String

    Dim bInfo As BROWSEINFO

    Dim path As String

    Dim r As Long, x As Long, pos As Integer

    bInfo.pidlRoot = 0&

    bInfo.lpszTitle = "Select a folder."

    bInfo.ulFlags = &H1

    x = SHBrowseForFolder(bInfo)

    path = Space$(512)

    r = SHGetPathFromIDList(ByVal x, ByVal path)

    If r Then

        pos = InStr(path, Chr$(0))

        GetDirectory = Left(path, pos - 1)

    Else

        GetDirectory = ""

    End If

End Function

Sub GetAFolder()

    Debug.Print GetDirectory()

End Sub

6.

Select a location containing the files you want to list

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Type BROWSEINFO

  hOwner As Long

  pidlRoot As Long

  pszDisplayName As String

  lpszTitle As String

  ulFlags As Long

  lpfn As Long

  lParam As Long

  iImage As Long

End Type

Sub ListFiles()

    Msg = "Select a location containing the files you want to list."

    Directory = GetDirectory(Msg)

    If Directory = "" Then Exit Sub

    If Right(Directory, 1) <> "\" Then Directory = Directory & "\"

    On Error Resume Next

    With Application.FileSearch

        .NewSearch

        .LookIn = Directory

        .Filename = "*.*"

        .SearchSubFolders = False

        .Execute

        For i = 1 To .FoundFiles.Count

            Debug.Print .FoundFiles(i)

            Debug.Print FileLen(.FoundFiles(i))

            Debug.Print FileDateTime(.FoundFiles(i))

        Next i

    End With

End Sub

Function GetDirectory(Optional Msg) As String

    Dim bInfo As BROWSEINFO

    Dim path As String

    Dim r As Long, x As Long, pos As Integer

    bInfo.pidlRoot = 0&

    If IsMissing(Msg) Then

        bInfo.lpszTitle = "Select a folder."

    Else

        bInfo.lpszTitle = Msg

  End If

    bInfo.ulFlags = &H1

    x = SHBrowseForFolder(bInfo)

    path = Space$(512)

    r = SHGetPathFromIDList(ByVal x, ByVal path)

    If r Then

        pos = InStr(path, Chr$(0))

        GetDirectory = Left(path, pos - 1)

    Else

        GetDirectory = ""

  End If

End Function

7.

processes multiple stored files

Sub BatchProcess()

    Dim Files() As String

    Dim FileSpec As String

    FileSpec = "c:\text.txt"

    NewPath = ExtractPath(FileSpec)

    FoundFile = Dir(FileSpec)

    If FoundFile = "" Then

        MsgBox "Cannot find file:" & FileSpec

        Exit Sub

    End If

    FileCount = 1

    ReDim Preserve Files(FileCount)

    Files(FileCount) = FoundFile

    Do While FoundFile <> ""

        FoundFile = Dir()

        If FoundFile <> "" Then

            FileCount = FileCount + 1

            ReDim Preserve Files(FileCount)

            Files(FileCount) = FoundFile

        End If

    Loop

    For I = 1 To FileCount

        Application.StatusBar = "Processing " & Files(I)

        Call ProcessFiles(Files(I))

    Next I

    Application.StatusBar = False

End Sub

Sub ProcessFiles(FileName As String)

    Workbooks.OpenText FileName:=FileName, Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(12, 1))

End Sub

Function ExtractPath(Spec As String) As String

    SpecLen = Len(Spec)

    For I = SpecLen To 1 Step -1

        If Mid(Spec, I, 1) = "\" Then

            ExtractPath = Left(Spec, I - 1)

            Exit Function

        End If

    Next I

    ExtractPath = ""

End Function

8.

Common File Operations Simplified

Sub TestGetFile()

    Dim nIndex As Integer 

    Dim sFile As String 

    sFile = GetExcelFile("Testing GetExcelFile Function") 

    If sFile = "False" Then 

        Debug.Print "No file selected." 

        Exit Sub 

    End If 

    Debug.Print sFile 

End Sub 

Function GetExcelFile(sTitle As String) As String 

    Dim sFilter As String 

    Dim bMultiSelect As Boolean 

    sFilter = "Workbooks (*.xls), *.xls" 

    bMultiSelect = False 

    GetExcelFile = Application.GetOpenFilename(FileFilter:=sFilter, _ 

        Title:=sTitle, MultiSelect:=bMultiSelect) 

End Function

9.

Use array to store a list of files

Sub XLFiles()

    Dim FName As String

    Dim arNames() As String

    Dim myCount As Integer

    FName = Dir("C:\*.xls*")

    Do Until FName = ""

        myCount = myCount + 1

        ReDim Preserve arNames(1 To myCount)

        arNames(myCount) = FName

        FName = Dir

    Loop

End Sub