I have this code to allow a user to select a folder, although they can only choose from a folder in the same subfolder as the active document. I have a couple requests. How can I enable the user to select any folder on their computer or authorized network? Also I would like the code to not import any data if the file is blank. Below is the code, any help would be greatly appreciated.
Code:
Sub Select_Folder()
Dim v_startfolder
v_startfolder = ThisWorkbook.Path & ""
Sheets("Import").Range("D9").Value = f_Pickafolder(ThisWorkbook.Path & "") & ""
End Sub
Function f_Pickafolder(Optional v_startatthis As Variant) As Variant
Dim v_obj1 As Object
Set v_obj1 = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Select folder to import Excel files", 0, v_startatthis)
On Error Resume Next
f_Pickafolder = v_obj1.self.Path
On Error GoTo 0
Set v_obj1 = Nothing
Select Case VBA.Mid(f_Pickafolder, 2, 1)
Case Is = ":"
If VBA.Left(f_Pickafolder, 1) = ":" Then GoTo errorsocomehere
Case Is = ""
If Not VBA.Left(f_Pickafolder, 1) = "" Then GoTo errorsocomehere
Case Else
GoTo errorsocomehere
End Select
Exit Function
errorsocomehere:
f_Pickafolder = False
End Function
Code:
Sub Lets_Prepare_Master()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim v_var1 As String, v_var2 As String, v_var3 As Integer
Dim eb As Workbook
Dim wb As Workbook
Dim lrineb As Long
Dim rineb As Long
Dim lrinm As Long
Set wb = ThisWorkbook
v_var1 = wb.Sheets("Import").Range("D9").Value
v_var2 = v_var1 & "\*.xls*"
v_excel = Dir(v_var2)
Do While v_excel <> ""
Debug.Print v_excel
Set eb = Workbooks.Open(wb.Sheets("Import").Range("D9").Value & v_excel)
lrineb = eb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
lrinm = wb.Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row + 1
eb.Sheets(1).Range("A2:F" & lrineb).Copy _
Destination:=wb.Sheets("Master").Range("A" & lrinm)
eb.Close False
v_excel = Dir()
Loop
End Sub
Last edited by a moderator:
