0

I am trying to integrate a folder picker instead of constant path into my code but am having issues with it. When I try to run the code from the developer the folder picker comes up, but then the excel workbook goes blank and Excel doesn't close, but it stops working. I referenced this Question: Folder Picker Excel VBA & paste Path to Cell but I am having issues with it. Here is the code I am working on:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, sh As Worksheet
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Dim fileExplorer As FileDialog
    Dim folderPath As String
    Dim LogSheet As Worksheet
    
    Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)

    'To allow or disable to multi select
    fileExplorer.AllowMultiSelect = False

    With fileExplorer
        If .Show = -1 Then 'Any folder is selected
            folderPath = .SelectedItems.Item(1)
        Else ' else dialog is cancelled
            MsgBox "You have cancelled the dialogue"
            folderPath = "" ' when cancelled set blank as file path.
        End If
        'Set strPath = .SelectedItems.Item(1)
        End With
            
    Set LogSheet = ThisWorkbook.Worksheets("Log")
    
    'Const strPath As String = "E:\\Desktop\Example\"
        'ChDir strPath
    strExtension = Dir(strPath & "*.xls*")
    
    Application.StatusBar = "Importing Data..."
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    
    Do While strExtension <> ""
        path = strPath & strExtension
        If VerifyTasks(strPath & strExtension, wkbDest) Then
            LogSheet.Range("A" & LogSheet.Rows.Count).End(xlUp).Offset(1, 0).Value = strPath & strExtension & "  " & "Succeeded"
        Else
            LogSheet.Range("A" & LogSheet.Rows.Count).End(xlUp).Offset(1, 0).Value = strPath & strExtension & "  " & "Failed"
        End If
        On Error GoTo 0
        
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
    Application.StatusBar = False
MsgBox "Data imported, review Log sheet."

End Sub

Function VerifyTasks(path As String, ByRef wkbDest As Workbook) As Boolean
    On Error GoTo errorhandler:
    Set wkbSource = Workbooks.Open(path)
    With wkbSource
       'locate last row to start copying new value from the next spreadsheet
        LastRow = wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
        'From the Basis & Credits cell AB46, copy to last row+1 in the Master sheet starting in row A2
        .Sheets("Basis & Credits").Range("AB46").Copy
         wkbDest.Sheets("Master").Range("A" & LastRow).PasteSpecial Paste:=xlPasteValues
        .Close savechanges:=False
    End With
    VerifyTasks = True
    Exit Function
errorhandler:
    VerifyTasks = False
    wkbSource.Close savechanges:=False
End Function

Any help would be appreciated. Thanks.

JosephD
  • 47
  • 1
  • 13
  • Going by your description, it sounds like there is no runtime error; the program just stalls. Is that accurate? If you step through the code, at what exact line does it stall? – BDra Jul 15 '20 at 23:14
  • 1
    `Option Explicit` would be a useful addition here... You populate `folderPath` but then go forward using `strPath ` – Tim Williams Jul 15 '20 at 23:45
  • Time williams, I added the `Option Explicit` reference and changed the `FolderPath` refernce to `strPath` (I pulled the folder select code from elsewhere and didn't notice the change in variable). I can run the code now without the program stalling, but now the rest of the code doesn't work (the loop doesn't run and data isn't pulled into the workbook now). Thoughts? – JosephD Jul 16 '20 at 04:58
  • You need to add some breakpoints to see which parts of your code are running, and do a little debugging. – Tim Williams Jul 16 '20 at 06:04

0 Answers0