• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Stop Vba execution if folder is not selected

S

Samadhan Gaikwad

Member
Hi,

I have a code which allow user to select folder (dir path) and add to one of the cell.
And there are some macros that run ahead.
But problem is when I do not select any folder and hit Cancel button, yet further code is executed. Also would like to show msg box to user to let know to select folder, if he did not select any.
Code: 
Function GetFolder() As String
    Dim fldr As FileDialog
    Dim ParentFolderName As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder to download PRdata into"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        ParentFolderName = .SelectedItems(1)
        Sheets("Download_PRdata1").Range("A28").Value = ParentFolderName
    End With
NextCode:
    GetFolder = ParentFolderName
    Set fldr = Nothing
    On Error Resume Next
End Function
 
Last edited:
Hi,

The example below will return the path to a variable (it is the same if you use a cell to store the value):
Code: 
Dim x As String
   
x = GetFolder("C:\")

If user cancels, thus not selecting any folder, it will return ""(empty). To exit and show message simply add an if statement after, like so:
Code: 
Sub test()

    Dim x As String
   
    x = GetFolder("C:\")
   
    If x = "" Then
        MsgBox "Canceled by user request..." & vbCrLf & "A folder must be selected in order to proceed!", vbInformation
        Exit Sub
    End If
   
End Sub

Hope this helps
 
Hi,

I am not able to figure out where should I put this code.

With GetFolder function, I am adding text to cell and then executing Downlaod sub.
For reference, copying the code.
Code: 
Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Dim ret As Long

Sub Download_new()

    On Error Resume Next
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long
    Dim strPath, FolderName, ParentFolderName As String
    ParentFolderName = Sheets("Download_PRdata1").Range("A28") & "\"

    'Sheets("Download_PRdata1").Range("A28").Value = ParentFolderName '& "\"
  
  
    Set ws = Sheets("Download_PRdata2")

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
  
    For i = 1 To LastRow
        
        FolderName = ParentFolderName & ws.Range("A" & i).Value & "\"
        If Dir(FolderName) = "" Then
            MkDir FolderName
        End If
      
        strPath = FolderName & ws.Range("C" & i).Value '& ".zip"
        ret = URLDownloadToFile(0, ws.Range("E" & i).Value, strPath, 0, 0)

        If ret = 0 Then
            ws.Range("F" & i).Value = "File successfully downloaded"
        Else
            ws.Range("F" & i).Value = "Unable to download the file"
        End If
      
Next

End Sub
Function GetFolder() As String
    Dim fldr As FileDialog
    Dim ParentFolderName As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder to download PRdata into"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        ParentFolderName = .SelectedItems(1)
        Sheets("Download_PRdata1").Range("A28").Value = ParentFolderName
    End With
NextCode:
    GetFolder = ParentFolderName
    Set fldr = Nothing
    On Error Resume Next
      
End Function
 
Hi,

Here you go... no need to store ParentFolderName in "A28":
Code: 
Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Dim ret As Long

Sub Download_new()

    On Error Resume Next
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long
    Dim strPath, FolderName, ParentFolderName As String

    Set ws = Sheets("Download_PRdata2")
    ParentFolderName = GetFolder("C:\")
  
    If ParentFolderName = "" Then
        MsgBox "Canceled by user request..." & vbCrLf & "Please provide a destination folder for the downloaded files!", vbInformation
        Exit Sub
    End If
  
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

    For i = 1 To LastRow
    
        FolderName = ParentFolderName & "\" & ws.Range("A" & i).Value & "\"
        If Dir(FolderName) = "" Then
            MkDir FolderName
        End If
  
        strPath = FolderName & ws.Range("C" & i).Value
        ret = URLDownloadToFile(0, ws.Range("E" & i).Value, strPath, 0, 0)

        If ret = 0 Then
            ws.Range("F" & i).Value = "File successfully downloaded"
        Else
            ws.Range("F" & i).Value = "Unable to download the file"
        End If
  
    Next i

End Sub

Function GetFolder(strPath As String) As String

    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select the destination folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing

End Function
 
Last edited:
Yeah, it's working as desired when run only that sub.
But I am using that sub. as part of main sub. Please find code. So though I do not select folder, it goes ahead running other stuff.
Code: 
Sub RunAll1()
    Application.ScreenUpdating = False
    'Call GetFolder
    Call ClearTextToColumns
    Call Import
    Call hyeprlink
    Call Download_new
    Call EMEAStatus
   
    Application.ScreenUpdating = True
    Dim varResponse As Variant
    varResponse = MsgBox("There may be some PR data located on at EMEA server.                If you want to proceed to download, hit 'Yes', else hit 'No' button. Note that macro will open all URLs for each file, you need to save them manually.", vbInformation + vbYesNo, "PR data on EMEA server")
    If varResponse <> vbYes Then Exit Function
    Application.ScreenUpdating = False
   
    Call HyperAdd
  ' Call ClearNonEEContent
    Call OpenHyperLinks
    Application.ScreenUpdating = True
    MsgBox "PR data download Completed!!"
End Function
 
I didn't test it but "call Download_new" should work (or simply "Download_new", you really don't need call in this occasion).

However, what is intriguing me is that you have Sub RunAll1() ... ending in End Function instead of End Sub.

One other thing you must know is that the IF statement from the previous post, the one that stops the subroutine if you do not select any folder, only exits that specific subroutine, the rest of the subroutine runAll1() will keep doing it's thing.

Please provide the sample file with all the subroutines, if you can, and I will gladly take a look at it.
 
Yeah, you are right. But do not know how it came there.
Just replaced
Code: 
Exit Function
and
Code: 
End Function
with
Code: 
End sub
It is working fine. But I think next 2 msg box pop-up which is undesired. Also would like to stop them. Shall I add them in subroutines?
 
Not really... it depends on what exactly should trigger the "exit sub"

In this case, from what you told me so far, you also want to exit "RunAll1" sub if user fails to provide a folder for the downloads during the download_new sub.

In that case, we can use the same statement as before (well, kind of)... first you will need to declare the "ParentFolderName" variable Public. First let's remove ParentFolderName from the "Dim" statement in the download_new sub by replacing:
Code: 
Dim strPath, FolderName, ParentFolderName As String
with
Code: 
Dim strPath, FolderName As String

Now, to declare it Public you will need to add:
Code: 
Public ParentFolderName As String

right after "Option Explicit" in the module where you have the download_new sub... when all is done it should look something like:
Code: 
Option Explicit

Public ParentFolderName As String

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Dim ret As Long

Sub Download_new()

    On Error Resume Next
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long
    Dim strPath, FolderName As String

    Set ws = Sheets("Sheet1")
    ParentFolderName = GetFolder("C:\")

    If ParentFolderName = "" Then
        MsgBox "Canceled by user request..." & vbCrLf & "Please provide a destination folder for the downloaded files!", vbInformation
        Exit Sub
    End If

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

    For i = 1 To LastRow

        FolderName = ParentFolderName & "\" & ws.Range("A" & i).Value & "\"
        If Dir(FolderName) = "" Then
            MkDir FolderName
        End If

        strPath = FolderName & ws.Range("C" & i).Value
        ret = URLDownloadToFile(0, ws.Range("E" & i).Value, strPath, 0, 0)

        If ret = 0 Then
            ws.Range("F" & i).Value = "File successfully downloaded"
        Else
            ws.Range("F" & i).Value = "Unable to download the file"
        End If

    Next i

End Sub

Function GetFolder(strPath As String) As String

    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select the destination folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing

End Function

Now you can use the exact same IF statement as before (maybe removing the msgbox part):
Code: 
Sub RunAll1()
    Application.ScreenUpdating = False
    Call ClearTextToColumns
    Call Import
    Call hyeprlink
    Call Download_new

    If ParentFolderName = "" Then
        Exit Sub
    End If

    Call EMEAStatus

    Application.ScreenUpdating = True
    Dim varResponse As Variant
    varResponse = MsgBox("There may be some PR data located on at EMEA server.                If you want to proceed to download, hit 'Yes', else hit 'No' button. Note that macro will open all URLs for each file, you need to save them manually.", vbInformation + vbYesNo, "PR data on EMEA server")
    If varResponse <> vbYes Then Exit Sub
    Application.ScreenUpdating = False

    Call HyperAdd
  ' Call ClearNonEEContent
     Call OpenHyperLinks
    Application.ScreenUpdating = True
    MsgBox "PR data download Completed!!"
End Sub

If I didn't mess it up :) it should now exit the main sub if user cancels when prompted to select a folder for the download.

Please let me know if it works.
 
Nice, it's working as expected. :)
Just 2 more things.
1) When I hit cancel it activates sheet "Download_PRdata2". I wanted to make 1st one active.
2) Also can we display "Download Completed" or new one with different text msg box when user hits "No" button in second msg box.
 
Samadhan Gaikwad said:
Nice, it's working as expected. :)
Just 2 more things.
1) When I hit cancel it activates sheet "Download_PRdata2". I wanted to make 1st one active.
2) Also can we display "Download Completed" or new one with different text msg box when user hits "No" button in second msg box.
Click to expand...

This should do it (don't forget to change the "sheet name here" to the name of the worksheet you wish to activate):
Code: 
Sub RunAll1()
    Application.ScreenUpdating = False
    Call ClearTextToColumns
    Call Import
    Call hyeprlink
    Call Download_new

    If ParentFolderName = "" Then
        Sheets("sheet name here").Activate
        Exit Sub
    End If

    Call EMEAStatus

    Application.ScreenUpdating = True
    Dim varResponse As Variant
    varResponse = MsgBox("There may be some PR data located on at EMEA server.                If you want to proceed to download, hit 'Yes', else hit 'No' button. Note that macro will open all URLs for each file, you need to save them manually.", vbInformation + vbYesNo, "PR data on EMEA server")
    If varResponse <> vbYes Then
        MsgBox "Download Completed"
        Exit Sub
    Application.ScreenUpdating = False

    Call HyperAdd
  ' Call ClearNonEEContent
    Call OpenHyperLinks
    Application.ScreenUpdating = True
    MsgBox "PR data download Completed!!"
End Sub
 
Hi,

Almost all is OK. But two more things are there that are working as intended.
1) I wanted to show 2nd msg box only when "F" coulmn has text "
Files are on EMEA server, couldn't download" in any cell.
2) Also when I hit "Yes" in the same msg box, right now (with existing code) remaining macros are not executed.
 
Try the following:
Code: 
Sub RunAll1()
    Application.ScreenUpdating = False
    Call ClearTextToColumns
    Call Import
    Call hyeprlink
    Call Download_new

    If ParentFolderName = "" Then
        Sheets("sheet name here").Activate
        Exit Sub
    End If

    Call EMEAStatus

    Application.ScreenUpdating = True
    Dim varResponse As Variant
    Dim EMEA As Range
  
    Set EMEA = Sheets("sheet name here").Columns("F").Find(What:="Files are on EMEA server, couldn't download")
  
    If Not EMEA Is Nothing Then
        varResponse = MsgBox("There may be some PR data located on at EMEA server." & vbCrLf & "If you want to proceed to download, hit 'Yes', else hit 'No' button." & vbCrLf & "Note that macro will open all URLs for each file, you need to save them manually.", vbInformation + vbYesNo, "PR data on EMEA server")
        If varResponse <> vbYes Then
            MsgBox "Download Completed"
            Exit Sub
        End If
    End If
  
    Application.ScreenUpdating = False
    Call HyperAdd
'    Call ClearNonEEContent
    Call OpenHyperLinks
    Application.ScreenUpdating = True
    MsgBox "PR data download Completed!!"
End Sub

Untested but try it out and let me know if there is something that needs to be fixed.
Note that there are now 2 instances where you will need to replace "sheet name here" with the actual sheet name. The 2nd should be the name of the sheet where we are going to look for the text "Files are on EMEA server, couldn't download".
 
You must log in or register to reply here.
Back
Top