Opening files in folder with loop - vba

I am trying to open excel files from a folder and copy and paste details into a master folder. Within each first level folder, there are some .xlsm files available to open, but there are also some within a second level folder within the first level folder (so an extra \filepath).
Right now, I am trying to figure out how to loop through the first level folder and open the "loose" workbooks (files in the first level folder that ARE NOT in a second level folder).
This is what I have. Please note I will eventually add another "level" of folders, hence the large amount of variables:
Sub Compile_RFQ_Parts()
Dim RFQ_Ecoat As String 'file path for RFQ folder in ecoat folder
Dim RFQ_VendorFolder As String 'file path for specific vendor
Dim RFQ_FileFolder As String 'file path for RFQ folder within a vendor folder
Dim RFQ_File As String 'file within RFQ #### style folder in vendor folder
Dim RFQ_FileLooseVendor As String 'loose file in vendor folder
Dim RFQ_FileLooseEcoat As String 'loose file in ecoat RFQ folder
Dim RFQ_Num As String 'Number of RFQ from formula
Dim DumpLocation As String 'Bulk workbook
Dim DumpSheet As String 'Target sheet in bulk workbook
Dim NextOpenCellRow As Integer 'next open cell at the dump location
Dim RFQcell As Range 'counter for each cell in "part number" range in RFQ file
Dim RFQrange As Range 'range to look for part numbers in RFQ file
Define Variables
RFQ_Ecoat = "S:\FACILITY\Sales\RFQ"
RFQ_VendorFolder = RFQ_Ecoat & "\Jensen Metals"
RFQ_FileLooseVendor = Dir(RFQ_VendorFolder & "\*.xlsm") 'wildcard to open spreadsheets
DumpLocation = "RFQ_Compile test target.xlsx"
DumpSheet = "Sheet1"
Begin Loop
'######loop through each .xlsm file in a Vendor folder (not in RFQ folder but loose in vendor folder)######
Do While RFQ_FileLooseVendor <> ""
Application.DisplayAlerts = False
Workbooks.Open Filename:=RFQ_VendorFolder & "\" & RFQ_FileLooseVendor, UpdateLinks:=False
Application.DisplayAlerts = True
'vvvvvv%%%%%%%%%Copy and pasting operations%%%%%%%%%vvvvvv
Next File in loop within Folder
Next
'#########close RFQ and loop to the next RFQ_FileLooseVendor#########
Application.DisplayAlerts = False
Workbooks(RFQ_FileLooseVendor).Close
Application.DisplayAlerts = True
RFQ_FileLooseVendor = Dir() '<<<This clears my RFQ_FileLooseVendor string, which ends my Do While loop before getting to other files
Loop
End Sub
When I get to the RFQ_FileLooseVendor=dir() line, it clears that variable (makes it = ""). I have seen this on countless other forums and I can't understand how it does not immediately end the Do While loop for everyone else like it does for me.

ISSUE WAS RESOLVED: It turns out it was something I used in my for loop within the do while loop. I used a Dir() function to equal the value of a cell. Creating a new variable as a string and having equate to my Dir() function solved it.
Was:
Workbooks(DumpLocation).Sheets(DumpSheet) _
.Range("A" & NextOpenCellRow + 1).Value =Dir(RFQ_VendorFolder, vbDirectory)
is now:
Workbooks(DumpLocation).Sheets(DumpSheet) _
.Range("A" & NextOpenCellRow + 1).Value = RFQ_Vendor

Related

Running List of CMD lines from Excel

Can anyone help please with the following requirements?
Requirement A:
I'd like to create a loop to run a list of command strings in CMD as long as there's a non-zero value in column C. I think I need to define a variable i for my starting row as this will always be the same, and then run Shell(), pulling the command string from the corresponding cell in Row i, Column F. While Cells(i, "C") is not blank, keep going, increasing i by 1.
Requirement B:
I'd also like to link this macro to work in a directory deposited in a cell by an earlier macro that listed all the files in a selected directory.
This is what I have, without any looping..
Sub Run_Renaming()
Dim CommandString As Long
Dim i As Integer
i = 5
'Other steps:
'1 - need to pick up variable (directory of files listed, taken from first macro
'when doing manually, I opened command, went to correct directory, then pasted
'the commands. I'm trying to handle pasting the commands. I'm not sure if I need
'something to open CMD from VBA, then run through the below loop, or add opening
'CMD and going to the directory in each iteration of the below loop...
'2 - Need to say - Loop below text if Worksheets("Batch Rename of Files").Cells(i, "C").Value is no blank
CommandString = Worksheets("Batch Rename of Files").Cells(i, "F").Value
Call Shell("cmd.exe /S /K" & CommandString, vbNormalFocus)
'Other steps:
'3 - need to increase i by 1
'4 - need to check if C column is blank or not
'5 - need to end of C column is blank
End Sub
Background:
I'm creating a file renaming tool for a friend. They can use excel, but no programming languages or command prompt. Because of this, I don't want to have any steps, like creating a batch file suggested here, that would complicate things for my friend.
I've created an excel file with:
Tab 1 - a template sheet to create a new file name list. Works by concatenating several cells, adding a filetype, and outputting to a range of cells. Tab two links to this range when creating the renaming command strings for CMD
Tab 2 -
Button 1 - Sub rename() below. VBA to list files in a selected directory in Column C
Column F creates a command line that will rename File A as File B based on inputs to Tab 1 i.e. ren "File 1" "A1_B1_C1.xlsx"
Button 2 - Refers to a renaming macro (requirement 1 and 2 above) that picks up the selected directory from Button 1 and runs through all the renaming command strings while in that directory
Sub rename()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\"
Worksheets("Batch Rename of Files").Activate
Worksheets("Batch Rename of Files").Range("C4").Activate
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub
Caveats:
1) I am not entirely clear on how you data etc is laid out so i am offering a way of achieving your goal that involves the elements i am clear on.
2) To be honest, personally, i would do as much using arrays or a dictionary as possible rather than going backwards and forwards to worksheets.
However...
Following the outline of your requirements and a little rough and ready, we have:
1) Using your macro rename (renamed as ListFiles and with a few minor tweaks) to write the chosen folder name out to Range("A1") in Worksheets("Batch Rename of Files") and the file names to Column C.
2) Using a second macro RenameFiles to pick up the rename shell commands from Column F of Worksheets("Batch Rename of Files"); write these out to a batch file on the desktop; add an additional first line command that sets the working directory to the chosen folder given in Range("A1") (Requirement A). The shell command executes the .bat file, completes the renaming (Requirement B) and then there is a line to remove the .bat file.
I am guessing this is a more efficient way of achieving your goal than looping the column F range executing a command one at a time.
I have not sought to optimize code in any further ways (i have added a few existing typed functions.) There are a number of other improvements that could be made but this was intended to help you achieve your requirements.
Let me know how it goes!
Tab1 layout (Sheet containing new file names):
Batch Rename of Files layout (Sheet containing output of the first macro and the buttons ):
Layout of Worksheet Batch Rename of File
In a standard module called ListFiles:
Option Explicit
Public Sub ListFilesInDirectory()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$ 'type hints not really needed
Dim wb As Workbook
Dim wsTab2 As Worksheet
Set wb = ThisWorkbook
Set wsTab2 = wb.Worksheets("Batch Rename of Files")
InitialFoldr$ = "C:\"
Dim lastRow As Long
lastRow = wsTab2.Cells(wsTab2.Rows.Count, "C").End(xlUp).Row
wsTab2.Range("C4:C" & lastRow).ClearContents 'Get rid of any existing file names
wsTab2.Range("C4").Activate
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
wsTab2.Range("A1") = xDirect$
Do While xFname$ <> vbNullString
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub
In a standard module called FileRenaming:
Option Explicit
Sub RenameFiles()
Dim fso As New FileSystemObject
Dim stream As TextStream
Dim strFile As String
Dim strPath As String
Dim strData As Range
Dim wb As Workbook
Dim wsTab2 As Worksheet
Dim currRow As Range
Set wb = ThisWorkbook
Set wsTab2 = wb.Worksheets("Batch Rename of Files")
strPath = wsTab2.Range("A1").Value2
If strPath = vbNullString Then
MsgBox "Please ensure that Worksheet Batch Rename of Files has a directory path in cell A1"
Else
If Right$(Trim$(strPath), 1) <> "\" Then strPath = strPath & "\"
strFile = "Rename.bat"
Dim testString As String
Dim deskTopPath As String
deskTopPath = Environ$("USERPROFILE") & "\Desktop" 'get desktop path as this is where .bat file will temporarily be saved
testString = fso.BuildPath(deskTopPath, strFile) 'Check if .bat already exists and delete
If Len(Dir(testString)) <> 0 Then
SetAttr testString, vbNormal
Kill testString
End If
Set stream = fso.CreateTextFile(deskTopPath & "\" & strFile, True) 'create the .bat file
Dim lastRow As Long
lastRow = wsTab2.Cells(wsTab2.Rows.Count, "C").End(xlUp).Row
Set strData = wsTab2.Range("F4:F" & lastRow) 'Only execute for as many new file names as present in Col C (in place of your until blank requirement)
stream.Write "CD /D " & strPath & vbCrLf
For Each currRow In strData.Rows 'populate the .dat file
stream.Write currRow.Value & vbCrLf
Next currRow
stream.Close
Call Shell(testString, vbNormalFocus)
Application.Wait (Now + TimeValue("0:00:01")) 'As sometime re-naming doesn't seem to happen without a pause before removing .bat file
Kill testString
MsgBox ("Renaming Complete")
End If
End Sub
Buttons code in Worksheet Batch Rename of Files
Private Sub CommandButton1_Click()
ListFilesInDirectory
End Sub
Private Sub CommandButton2_Click()
RenameFiles
End Sub
Example .bat file contents:
VERSION 2
And here is a different version using a dictionary and passing parameters from one sub to another. This would therefore be a macro associated with only one button push operation i.e. there wouldn't be a second button. The single button would call ListFiles which in turn calls the second macro. May require you to go in to tools > references and add in Microsoft Scripting Runtime reference.
Assumes you have a matching number of new file names in Col D of tab 1 as the number of files found in the folder (as per your script to obtain files in folder). I have removed the obsolete type references.Shout out to the RubberDuck VBA add-in crew for the add-in picking these up.
In one standard module:
Option Explicit
Public Sub ListFiles()
Dim xDirect As String, xFname As String, InitialFoldr As String
Dim wb As Workbook
Dim ws As Worksheet
Dim dict As New Scripting.Dictionary
Dim counter As Long
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Tab1") 'Worksheet where new file names are
counter = 4 'row where new file names start
InitialFoldr = "C:\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr
.Show
If .SelectedItems.Count <> 0 Then
xDirect = .SelectedItems(1) & "\"
xFname = Dir(xDirect, 7)
Do While xFname <> vbNullString
If Not dict.Exists(xFname) Then
dict.Add xFname, ws.Cells(counter, "D") 'Or which ever column holds new file names. This add to the dictionary the current name and new name
counter = counter + 1
xFname = Dir
End If
Loop
End If
End With
RenameFiles xDirect, dict 'pass directory path and dictionary to renaming sub
End Sub
In another standard module:
Public Sub RenameFiles(ByVal folderpath As String, ByRef dict As Dictionary)
Dim fso As New FileSystemObject
Dim stream As TextStream
Dim strFile As String
Dim testString As String
Dim deskTopPath As String
strFile = "Rename.bat"
deskTopPath = Environ$("USERPROFILE") & "\Desktop"
testString = fso.BuildPath(deskTopPath, strFile)
'See if .dat file of same name already on desktop and delete (you could overwrite!)
If Len(Dir(testString)) <> 0 Then
SetAttr testString, vbNormal
Kill testString
End If
Set stream = fso.CreateTextFile(testString, True)
stream.Write "CD /D " & folderpath & vbCrLf
Dim key As Variant
For Each key In dict.Keys
stream.Write "Rename " & folderpath & key & " " & dict(key) & vbCrLf 'write out the command instructions to the .dat file
Next key
stream.Close
Call Shell(testString, vbNormalFocus)
Application.Wait (Now + TimeValue("0:00:01")) 'As sometime re-naming doesn't seem to happen without a pause before removing .bat file
Kill testString
' MsgBox ("Renaming Complete")
End Sub
Scripting run time reference:
Adding runtime reference
Additional method for finding the desktop path. Taken from Allen Wyatt:
In a standard module add the following:
Public Function GetDesktop() As String
Dim oWSHShell As Object
Set oWSHShell = CreateObject("WScript.Shell")
GetDesktop = oWSHShell.SpecialFolders("Desktop")
Set oWSHShell = Nothing
End Function
Then in the rest of the code replace any instances of deskTopPath =..... e.g.:
deskTopPath = Environ$("USERPROFILE") & "\Desktop"
With
desktopPath = GetDesktop

Issues using wildcards with strings in Dir function VBA

I am currently working on user customisability in VBA while searching through some other workbooks. I am having issues converting my FileName expression in the Dir() function into a path directory with the correct backslash after my folder name, and then using wildcards around File to allow Dir to search for all occurrences of a keyword. Currently I believe the \ is omitted, and I can't yet tell if my wildcards are working
' Modify this folder path to point to the files you want to use.
Folder = InputBox("Enter folder directory of files")
' e.g C:\peter\management\Test Folder
File = InputBox("Enter filename keyword")
'e.g. PLACE
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(Folder & "\" & "*" & File & "*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
I am assuming my syntax is incorrect for what I am trying to achieve. Any help would be appreciated!
EDIT:
' Modify this folder path to point to the files you want to use.
Folder = InputBox("Enter folder directory of files")
' e.g C:\peter\management\Test Folder
File = InputBox("Enter filename keyword")
'e.g. PLACE
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(Folder & "\" & File & "*" & ".xls")
Debug.Print (FileName)
' Loop until Dir returns an empty string.
Do While FileName <> ""
Is what I am currently working with. The "\" in my Dir line doesn't seem to do anything as I still have to add the final \ before the file manually for it to appear in my error message.
When I tried your code it worked for me. Needless to say, that makes it a little tricky to provide a satisfactory answer!
Below is my attempt to solve the same problem.
Instead of asking the user to manually type the folder address I've used Excel's built-in folder picker. This avoids the need to check for and deal with typos.
Sub FindFiles()
Dim fldDialog As FileDialog ' Holds a reference to the folder picker.
Dim path As String ' Folder selected by user.
Dim fileFilter As String ' Provided by user, wildcard supported.
Dim found As String ' Used to display returned results.
' Config dialog.
Set fldDialog = Application.FileDialog(msoFileDialogFolderPicker)
fldDialog.Title = "Pick a folder" ' Caption for dialog.
fldDialog.AllowMultiSelect = False ' Limit to one folder.
fldDialog.InitialFileName = "C:\" ' Default starting folder.
' Display to user.
If fldDialog.Show Then
' Config filter.
path = fldDialog.SelectedItems(1)
fileFilter = InputBox("Select a filter (*.*)", "File filter", "*.*")
' Get results.
found = Dir(path & "\" & fileFilter)
Do Until found = vbNullString
MsgBox found, vbInformation, "File found"
found = Dir()
Loop
Else
MsgBox "User pressed cancel", vbInformation, "Folder picker"
End If
End Sub

VBA check if file exists in sub folders

I am relatively amateur at VBA and am using a code provided by tech on the net.
I have an Excel document with files names in column B (not always one file type) which I am trying to ensure I have copies and the correct revision in a designated folder.
Currently, the code works perfectly for a specific folder location, but the files referenced in the Excel spreadsheet exist in various other folders and thus I need to create a code that can search a main folder and loop through the various sub-folders.
See current code below for reference.
Sub CheckIfFileExists()
Dim LRow As Integer
Dim LPath As String
Dim LExtension As String
Dim LContinue As Boolean
'Initialize variables
LContinue = True
LRow = 8
LPath = "K:\location\main folder\sub folder \sub folder"
LExtension = ".pdf"
'Loop through all column B values until a blank cell is found
While LContinue
'Found a blank cell, do not continue
If Len(Range("B" & CStr(LRow)).Value) = 0 Then
LContinue = True
'Check if file exists for document title
Else
'Place "No" in column E if the file does NOT exist
If Len(Dir(LPath & Range("B" & CStr(LRow)).Value & LExtension)) = 0 Then
Range("E" & CStr(LRow)).Value = "No"
'Place "Yes" in column E if the file does exist
Else
Range("E" & CStr(LRow)).Value = "Yes"
End If
End If
LRow = LRow + 1
Wend
End Sub
There are over 1000 documents, so simple windows searches is not ideal, and I have reviewed several previous questions and cannot find an answer that helps.
Okay, my answer is going to revolve around 2 comments from your question. This will serve only as a basis for you to improve upon and adapt to how you need it.
N.B SKIP TO THE BOTTOM OF MY ANSWER TO SEE THE FULL WORKING CODE
The first comment is:
I need to create a code that can search a main folder and loop through the various sub-folders.
The code i will explain below will take a MAIN FOLDER, that you will need to specify, and then it will loop through ALL subfolders of the parent directoy. So you will not need to worry about specific sub folders. As long as you know the name of the file you want to access, the code will find it regardless.
The second is a line of your code:
LPath = "K:\location\main folder\sub folder \sub folder"
This line of code will form part of a UDF (User Defined Function) that i will display below.
Step 1
Re-label LPath to be the what is called the "Host Folder". This is the MAIN FOLDER.
For Example: Host Folder = "K:\User\My Documents\" (Note the backslash at the end is needed)
Step 2
Set a reference to Microsoft Scripting Runtime in 2 places:
i) In the code
Set FileSystem = CreateObject("Scripting.FileSystemObject")
ii) In the VBA Editor. (To a basic google search on how to find the reference library in the VBA editor)
Step 3
This is the main element, this is a sub routine that will find the file no matter where it is, providing a file name and host folder has been provided.
Sub DoFolder(Folder)
Dim SubFolder
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
If File.Name = "Specify Name.pdf" Then
Workbooks.Open (Folder.path & "\" & File.Name), UpdateLinks:=False
Workbooks(File.Name).Activate
Exit Sub
End If
Next
End Sub
The code above will simply open the file once it has found it. This was just my own specific use; adapt as necessary.
MAIN CODE
Option Explicit
Dim FileSystem As Object
Dim HostFolder As String
Sub FindFile()
HostFolder = "K:\User\My Documents\"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)
End Sub
Sub DoFolder(Folder)
Dim SubFolder
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
If File.Name = "Specify Name.pdf" Then
Workbooks.Open (Folder.path & "\" & File.Name), UpdateLinks:=False
Workbooks(File.Name).Activate
Exit Sub
End If
Next
End Sub
You can chop this up how you see fit, you can probably throw it into your sub CheckIfFileExists() or just use it on its own.
Let me know how you get along so i can help you understand this further

VBA Copyfile from and excel sheet : Invalid procedure call or argument (Error 5)

list file image
i want to copyfile from a list in excel sheet if there isn t any file their . But i have an error 5 in fso.CopyFile filepath, Destination .
I do not know what is the problem , can you help me
Set fso = CreateObject("scripting.filesystemobject")
Destination = "C:\Users\test\"
Set oFolder = fso.GetFolder(Destination)
Set workboo = Workbooks.Open("C:\Users\listing.xlsx")
Set worksh = workboo.Worksheets("List_File")
For j = 1 To 10
numrows = worksh.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To numrows
icol = 2 * j - 1
filepath = worksh.Cells(i, icol).Value
If Not fso.FileExists(Destination) Then
fso.CopyFile filepath, Destination
End If
Next
Next
workboo.Close
End Sub
Your code expect Destination to be a file, but it is a directory. FSO documentation tells you that:
If source contains wildcard characters or destination ends with a path separator (), it is assumed that destination is an existing
folder in which to copy matching files. Otherwise, destination is
assumed to be the name of a file to create. In either case, three
things can happen when an individual file is copied.
If destination does not exist, source gets copied. This is the usual case.
If destination is an existing file, an error occurs if overwrite is False. Otherwise, an attempt is made to copy source over the
existing file.
If destination is a directory, an error occurs.
Make sure either Destinationis set to a filename, not a directory, or that filepath is set to multiple files using wildcards.
BTW, if Destination is expected to remains a directory, you shouldn't test fso.FileExists(Destination).
You can use BuildPath() and GetFileName() to construct the destination filename if needed:
Public Sub SomeName()
Set fso = CreateObject("scripting.filesystemobject")
Destination = "C:\Users\test\"
Set oFolder = fso.GetFolder(Destination)
Set workboo = Workbooks.Open("C:\Users\listing.xlsx")
Set worksh = workboo.Worksheets("List_File")
For j = 1 To 10
numrows = worksh.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To numrows
icol = 2 * j - 1
filepath = worksh.Cells(i, icol).Value
filedest = fso.BuildPath(Destination,fso.GetFileName(filepath))
If Not fso.FileExists(filedest) Then
fso.CopyFile filepath, filedest
End If
Next
Next
workboo.Close
End Sub
I didn't edit much your code, but defining you variable with Dim ... should be a good idea.
As per information gathered from you, I have designed the program. I have kept source Folder and file string separately. To extract file name, I have used TRIM and MID functions.
sFile = Trim(Mid((worksh.Cells(i, icol).Text), 39, 99))
You may check the length of the Source Folder "P:\Desktop\Nouveau dossier (4)\Source\" exactly by LEN function and then add 1 to that length for start of file name. Further I have kept total number of characters tentatively 99 which you may adjust according to maximum file name length you are using. Please also ensure that source and destination folders are correct in the program and match with your physical folder paths on your computer. I have tested it on my computer and it is working fine on sample data.I have also set reference to Microsoft Scripting Runtime Library.
Sub CopyingFiles_Q37539919()
'Declaration
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String
Dim i As Integer, j As Integer
Dim icol As Long
Dim numrows As Long
Set workboo = Workbooks.Open("C:\Users\listing.xlsx")
Set worksh = workboo.Worksheets("List_File")
numrows = worksh.Range("A" & Rows.Count).End(xlUp).Row
Debug.Print numrows
'Change to match the source folder path.
sSFolder = "C:\mydir_s\" '
'Change to match the destination folder path.
sDFolder = "C:\Users\test\"
For j = 1 To 10
For i = 2 To numrows
icol = 2 * j - 1
sFile = Trim(Mid((worksh.Cells(i, icol).Text), 39, 99)) ' Adjust the figure 39 for start of file name and 99 for maximum length of file name
Debug.Print sFile
Debug.Print sSFolder & sFile
'Create Object for File System
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FileExists(sSFolder & sFile) Then
MsgBox "Specified File Not Found in Source Folder", vbInformation, "Not Found"
End If
'Copying If the Same File is Not Located in the Destination Folder
If Not FSO.FileExists(sDFolder & sFile) Then
FSO.CopyFile (sSFolder & sFile), sDFolder, True
MsgBox "Specified File Copied to Destination Folder Successfully", vbInformation, "Done!"
Else
MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If
Next
Next
End Sub
On seeing your code i agree with Trimax the area of problem he is pointing. Apart from that you need to make sure followings:
1. Make sure "filepath" variable is fully qualified path for the file like "d:\yourdirctoryname\yourfilename.extension"
2. Make sure file exists at source location if not the same validation you can write for "filepath" as you did for "destination"
3. if you have same extension files to be copied then you should use wildcard to copy file to the destination it will reduce system effort. For more detail follow https://msdn.microsoft.com/en-us/library/e1wf9e7w(v=vs.84).aspx for wildcard code.
I believe it will resolve the issue.

excel-VBA: copying last column with dynamic paths and names

I have a xlsm that amonst others runs through all .xslx files in a directory, runs a sub, saves them. (Thank you Tabias)
inside this sub I am now trying to add something that would add the last column from a third file.
My first problem here is how to define the sourcefile. We need to take data from the exact file, with a similar name. So MC.xslx ahs to copy from MC12february.xlsx and KA.xlsx has to import from KAwhateverdate.xlsx
Set wbA = Workbooks.Open("C:\files" & "\" & ActiveWorkbook.Name & "*.xlsx")
unfortunately, active.workbook.name includes the extention, so OR you guys can tell me a solution OR i have to save the files date+name first and change it into wbA = Workbooks.Open("C:\files" & "\*" & ActiveWorkbook.Name) right?
The same goes for the sheet. Those wil, depending on the file, be called MC, KA,KC,...
Next since i only want to copy the last column of the file into the last column of the other file I'm quite confused. I found this code and thought it was the most understandable.
Sub import()
Dim Range_to_Copy As Range
Dim Range_Destination As Range
Dim Sheet_Data As Worksheet 'sheet from where we pull the data
Dim Sheet_Destination As Worksheet ' destination
Dim workbook_data As Workbook
Dim workbook_destination As Workbook
Set workbook_data = "N:\blah\deposit" & "\*" & ActiveWorkbook.Name
Set workbook_detination = ActiveWorkbook
Set Sheet_Data = ThisWorkbook.Sheets("Sheet1") 'help, how do i do this?
Set Sheet_Destination = ThisWorkbook.Sheets("Sheet1") ' and this?
Set Range_to_Copy = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
Set Range_Destination = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
Range_to_Copy.Copy Range_Destination 'this copies from range A to B (basically A.copy B), but i changed variable names to make it easier...
'you can simplify without variables like this:
'Sheets("Sheet1").Range("D1").Copy Sheets("Summary).Range("A1") <===== does the same as the above coding
None of the more simpler solutions seemed fit either. example
As you see I'm completely stuck at how to define the last column and the name of the sheet. This code is to uncomplete for me to check by doing. Can someone put me on the right path? thank you.
As a supplement, I'd suggest creating a simeple, re-usable file open functions where you can provide a filename as a String that you'd like to search for. The function will loop through a directory (as Batman suggested) and, optionally, pull the most recent version (using date modified) of that file. Below is a set of functions that I use frequently. There is a subfolder parameter `subF' that will allow you to search within subfolder(s) relative to the current file location.
'FUNCTION opnWB
'--Opens a workbook based on filename parameter
'----WILDCARDS before and after the filename are used to allow for filename flexibility
'----Subfolder is an OPTIONAL PARAMETER used if the location of the file is located in a subfolder
Public Function opnWB(ByVal flNM As String, Optional ByVal subF As String = "") As Workbook
If subF <> "" Then subF = "\" & subF
Dim pthWB As String
pthWB = "\*" & flNM & "*" 'wildcard characters before and after filename
pthWB = filePull(subF, pthWB)
Set opnWB = Workbooks.Open(ActiveWorkbook.path & subF & "\" & pthWB, UpdateLinks:=0)
End Function
'FUNCTION filePull
'--Cycles through folder for files that match the filename parameter (with WILDCARDS)
'--If there is more than one file that matches the filename criteria (with WILDCARDS),
'----the file "Date Modified" attribute is used and the most recent file is "selected"
Private Function filePull(ByVal subF As String, ByVal path As String) As String
Dim lDate, temp As Date
Dim rtrnFl, curFile As String
Filename = Dir(ActiveWorkbook.path & subF & path)
Do While Filename <> ""
curFile = Filename
curFile = ActiveWorkbook.path & subF & "\" & Filename
If lDate = 0 Then
rtrnFl = Filename
lDate = GetModDate(curFile)
Else
temp = GetModDate(curFile)
End If
If temp > lDate Then
rtrnFl = Filename
lDate = temp
End If
Filename = Dir()
Loop
filePull = rtrnFl
End Function
'FUNCTION GetModDate
'--Returns the date a file was last modified
Public Function GetModDate(ByVal filePath As String) As Date
GetModDate = CreateObject("Scripting.FileSystemObject").GetFile(filePath).DateLastModified
End Function
You could tweak this method where the filename would have to start file the String you pass in by simply removing the wildcard character before flNM. To use, you would simply call the opnWB function, passing in "MC" or whatever general file name you'd like to open:
Dim wbTarMC as Workbook
Set wbMC = opnWB("MC", "Source Files") 'this would open up MC.xlsx file within the subfolder "Source Files" (relative to current file location)
Hope this helps.