• 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.

Want to replace Folder Picker with C drive Folder Path

jexcel j

New Member
Hi All,

I have below code which allows user to open Folder containing excel file and then next code (InputDump) works on the opened file to extract data.

Now I want to replace the Folder Picker with C:\Test and run the second macro. I tried with the basic knowledge I have but its not allowing me to run the second macro.

No change is required in the "InputDump" code. Only change in Initial code to replace Folder Picker with direct file opening from C drive folder

Your quick response is highly appreciated. Thanks in advance

Code:
Option Explicit
Sub NewBCPull()
Dim foldName As String
Dim fileName As String

'Get folder location of Input files
With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  .InitialFileName = ThisWorkbook.path
  .Title = "Please select folder with Input files"
  .Show
  If .SelectedItems.Count < 1 Then
  'User aborted
  Exit Sub
  Else
  foldName = .SelectedItems(1) & "\"
  End If
End With

Application.ScreenUpdating = False

'Retrieve file names
fileName = Dir(foldName & "*.xl*")

'Retrieve each input file
Do While fileName <> ""
  Call InputDump(foldName & fileName)
  fileName = Dir()
Loop
Application.ScreenUpdating = True


End Sub

Sub InputDump(fName As String)

Dim wbSource As Workbook
Dim wbDest As Workbook
Dim fCell As Range
Dim fVal As Date
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim vFile As Variant
Dim lastCol As Long
Dim lastRow As Long


Set wbDest = ThisWorkbook
Set wsDest = wbDest.Worksheets("Staffing Plan")

'Paste in new row
With wsDest
  lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row + 1
  If lastRow < 1 Then lastRow = 1
End With

Set wbSource = Workbooks.Open(fileName:=fName, UpdateLinks:=False)
Set wsSource = wbSource.Worksheets("Staffing Plan")

'Find where to paste new data
fVal = wsSource.Range("J3").Value

Set fCell = wsDest.Range("1:1").Find(what:=fVal, LookIn:=xlFormulas, lookat:=xlWhole)

If fCell Is Nothing Then
  MsgBox "Date not found, please correct Master sheet"
  GoTo escapeClause
End If

With wsSource
  'Find the last column of data
  lastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
  'Note that none of these copy over formatting. Used original code as a guide
  'Insert file name
  wsDest.Cells(lastRow, "B").Value = wbSource.Name
  'Copy headings
  wsSource.Range("A4:I150").Copy
  wsDest.Cells(lastRow, "C").PasteSpecial xlPasteValues
  wsDest.Cells(lastRow, "C").PasteSpecial xlPasteFormats
  'Copy data below correct data
  wsSource.Range("J4", .Cells(150, lastCol)).Copy
  wsDest.Cells(lastRow, fCell.Column).PasteSpecial xlPasteValues
  wsDest.Cells(lastRow, fCell.Column).PasteSpecial xlPasteFormats
End With

escapeClause:
Application.CutCopyMode = False
'Close input file, don't save any changes
wbSource.Close False

End Sub

------------------------------------------------------------------------------------------
MOD EDIT: Added code tag
 
Last edited by a moderator:
Please edit your post & use CODE tags as per forum rules. Below is your edited code

Code:
Option Explicit
Sub NewBCPull()
Dim foldName As String
Dim fileName As String

'Get folder location of Input files
foldName = "C:\TEST\"

Application.ScreenUpdating = False

'Retrieve file names
fileName = Dir(foldName & "*.xl*")

'Retrieve each input file
Do While fileName <> ""
    Call InputDump(foldName & fileName)
    fileName = Dir()
Loop
Application.ScreenUpdating = True

End Sub
 
Thanks Chirayu for the solution it worked as I wanted. Appreciate your quick reply.

I am not aware about the CODE tags tried searching in the guidelines but didn't get any information related to it. I mean how to do that.
 
Also sorry to be a pain but can you guide me further in this as in my original code I am pulling data from worksheet named "Staffing Plan". Is there any way where if the tab name changes to different name still the code works

Set wsDest = wbDest.Worksheets("Staffing Plan") - any alternative if the sheet name changes

Thanks in Advance
JJ
 
I think you mean wsSource as that's where its pulling the data from. wsDest is where its going to.

As for it working on the sheet once the names changed. there's a few ways of doing it. first way is to use the "Like" argument to figure out if a similarly named sheet is available in the file and the second method is if you know the sheet position will always be the same in the file i.e. if the Staffing Plan is always the second sheet in the file etc.
 
Back
Top