Browse for folder error

**abousetta** · 04-28-2010, 07:36 PM

Good morning, afternoon or evening (depending on wherer you are),

How do I get the function below to get the folder name below to pass to the sub?

Option Explicit

Sub GetFolderName()

Dim FolderName              As String
Dim sFName                  As String
Dim sFPath                  As String

FolderName = BrowseForFolder

sFName = Dir$(FolderName \ "*.txt")

Do While sFName <> ""

MsgBox (sFName)

'Get next file name
    sFName = Dir$
    sFPath = FolderName
    sFNamePath = sFPath + sFName

Loop

End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function

Right now it gives me nothing. I keep getting Run-time error '13': Type mismatch. When I remove the loop and put FolderName in the MsgBox it gives me the correct folder that I chose, so the function works, but I can't get it to work with the loop. Can anyone help me out?

Thanks.

abousetta

**shg** · 04-28-2010, 09:25 PM

Maybe like this:

Sub GetFolderName()
    Dim sFName      As String
    Dim sFPath      As String
    Dim sFullName   As String

    sFPath = BrowseForFolder()
    If Len(sFPath) = 0 Then Exit Sub

    sFName = Dir$(sFPath & "*.txt")

    Do While Len(sFName)
        MsgBox sFName
        sFName = Dir$()
        sFullName = sFPath + sFName     ' this doesn't accomplish anything
    Loop
End Sub

Function BrowseForFolder() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select directory"
        .InitialFileName = ThisWorkbook.Path & "\"
        .AllowMultiSelect = False
        If .Show = 0 Then Exit Function
        BrowseForFolder = .SelectedItems(1) & "\"
    End With

    Select Case Left(BrowseForFolder, 2)
        Case "L:", "\\"
            ' all good
        Case Else
            BrowseForFolder = vbNullString
    End Select
End Function

**abousetta** · 04-28-2010, 10:38 PM

Thanks shg. I tried the code you posted but for some reason regardless of the folder I chose, it gave me only the txt files on C:\. I don't know why its ignoring my decision and defaulting to C:\.

I have been working on it all day and make a breakthrough (at least a small one) and got the original code to work. Here is the modified code:

Option Explicit

Sub LoopThroughFiles()

Dim sFPath        As String
Dim sFName        As String
Dim sFNamePath    As String

sFPath = (BrowseForFolder & "\")
sFName = Dir$(sFPath & "*.txt")

Debug.Print sFName

Do While sFName <> ""

MsgBox (sFName)

'Get next file name
    sFName = Dir$
    sFNamePath = sFPath + sFName
Loop

End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function

Even though, it works only to give me the file names in a msg box. When I try to combine it with other code, I get an error saying that the file does not exist. Below is an example which incorporates the code above with the code that you generously created for me in a previous thread.

Sub LoopThroughFiles()

Dim sFPath        As String
Dim sFName        As String
Dim sFNamePath    As String
Dim iFF           As Integer
Dim sInp          As String
Dim asDat(1 To 3) As String
Dim iRow          As Long


sFPath = (BrowseForFolder & "\")
sFName = Dir$(sFPath & "*.txt")

Debug.Print sFName

Do While sFName <> ""

    iFF = FreeFile
    Open sFName For Input As #iFF

    Do While Not EOF(iFF)
        Line Input #iFF, sInp

        Debug.Print Left(sInp, 6)
        Select Case Left(sInp, 6)
            Case "TY  - "
                asDat(2) = Mid(asDat(2), 7)
                If iRow <> 0 Then Cells(iRow, "B").Value = Join(asDat, ", ")
                Erase asDat
            Case "ID  - "
                iRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
                Cells(iRow, "A").Value = Mid(sInp, 7)
            Case "A1  - "
                If Len(asDat(1)) = 0 Then asDat(1) = Mid(sInp, 7)
            Case "JF  - "
                asDat(2) = sInp
            Case "JO  - "
                Select Case Left(asDat(2), 6)
                    Case "JA  - ", "J1  - ", "J2  - ", vbNullString
                        asDat(2) = sInp
                End Select
            Case "JA  - "
                Select Case Left(asDat(2), 6)
                    Case "J1  - ", "J2  - ", vbNullString
                        asDat(2) = sInp
                End Select
            Case "J1  - "
                Select Case Left(asDat(2), 6)
                    Case "J2  - ", vbNullString
                        asDat(2) = sInp
                End Select
            Case "J2  - "
                Select Case Left(asDat(2), 6)
                    Case vbNullString
                        asDat(2) = sInp
                End Select
            Case "Y1  - "
                asDat(3) = Mid(sInp, 7, 4)
            Case "T1  - "
                Cells(iRow, "C").Value = Mid(sInp, 7)
            Case "N2  - "
                Cells(iRow, "D").Value = Mid(sInp, 7)
            Case "KW  - "
                With Cells(iRow, "E")
                    If IsEmpty(.Value) Then
                        .Value = Mid(sInp, 7)
                    Else
                        .Value = .Value & "; " & Mid(sInp, 7)
                    End If
                End With
        End Select
    Loop

    If IsEmpty(Cells(iRow, "B")) Then
        asDat(2) = Mid(asDat(2), 7)
        Cells(iRow, "B").Value = Join(asDat, ", ")
    End If
    Close iFF

'Get next file name
    sFName = Dir$
    sFNamePath = sFPath + sFName
Loop

End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function

I don't know why it doesn't work even though I got to work earlier today, but like an idiot I forgot to save the file and I can't get it to work again. I have been pulling my hair out at the roots because I am so frustrated with this. I hope you can help me resolve this issue.

Thanks again.

abousetta

**abousetta** · 04-29-2010, 10:41 AM

Hi shg,

I dont' know if there is something wrong with my system or what, but last night I finally got it work. So to test it, I saved the xlsm file and reopened it to see if worked and it wouldn't work again. It started giving me the same errors again. As a last ditch attempt I am uploading the excel file with the two modules containing the modified code that at one time worked and the code you posted yesterday. Also I am uploading three identical dummy text files that I used for test runs.

I hope you can help me out because this looping through files issues is critical to my project.

Thanks.

abousetta

**abousetta** · 04-29-2010, 02:47 PM

Hi again,

OK, now I know that I am not crazy because I got it to work again (this time on another computer). Once I saved the file and reopened it, it won't work again. I have stripped the code down the to the basic part to show where it hangs.

Sub GetFolderName()
Dim sFName      As String
Dim sFPath      As String


sFPath = (BrowseForFolder() & "\")
    If Len(sFPath) = 0 Then Exit Sub

sFName = Dir$(sFPath & "*.txt")

Do While Len(sFName)

    iFF = FreeFile
    Open sFName For Input As #iFF
 
 ' Do something
  
    Close iFF
    
sFName = Dir$()
Loop

End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     
    Dim ShellApp As Object
     
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
    Set ShellApp = Nothing
     
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
    BrowseForFolder = False

End Function

It stops at the following line of code:

    Open sFName For Input As #iFF

When I change the code to just send the file name to a messag box, it works fine, but it seems to have a problem opening the file. I hope you could tell me why this happening.

Thanks.

abousetta

**abousetta** · 04-29-2010, 04:07 PM

Another addition to this saga.

I have checked again on a completely different computer than the ones I have used before and the problem doesn't seem to be with the BrowseForFolder Function. I am assuming this because I have replaced the function with the actual path and it worked... the first time. And then every time after that it gave the Run-time error '53': File not found. Even when I create a new workbook and add the code to a new module, it still gives me the same error. Its as if the files are now locked for use by only the first instance of the macro running. Could there be some hidden link that is causing this bug?

abousetta

**JBeaucaire** · 04-29-2010, 05:05 PM

This is the technique I use most often to select a folder name:

Dim fPath As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\"
    End With

You could add in an abort if the user failed to select a folder:

Dim fPath As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then 
           fPath = .SelectedItems(1) & "\"
        Else
           End
        End If
    End With

With these, you wouldn't need to call a separate standalone function.

**abousetta** · 04-29-2010, 05:26 PM

Thanks JB... It has been a very big help. I tried it out right now and maybe the real culprit was the function after all. I don't know anymore...

I want to be optimistic and say that it is working fine but I don't want to jinx myself. I will say that my first trial run worked well and I will keep testing it in different environments and make sure the issue truely is solved.

Thanks again everyone. And of course a special thanks to shg and JB who have put up with my numerous posts.

Best wishes,

abousetta