I have the following code:
Dim MyFile As String
MyFile = Dir(folder & "*.xl*")
MsgBox (MyFile)
Dim OpenTime As Date
OpenTime = FileDateTime(folder & MyFile)
In which folder is a public string set in a different module. And it's value is retrieved like such Application.FileDialog(msoFileDialogFolderPicker)
Now the problem I face is that MsgBox (MyFile) returns an empty messagebox, but the value of OpenTime is consistent with that of the first file in the selected folder.
So that leaves me to believe that folder is set correctly, which I confirmed using the direct window:
debug.Print(folder)
D:\CLM\Enquete\Aardappel
Printing the variables MyFile and OpenTime resulted in this:
debug.print(MyFile)
debug.Print(OpenTime)
12-6-2018 15:04:18
Any thougts on this?
Your final path pattern has no slash before file name. Change it to:
folder = "D:\CLM\Enquete\Aardappel\"
or if folder path is not hardcoded, to:
folder = folder & "\"
Related
I would like to open the latest file in a shared folder.
I have a code to check the files in a folder of my laptop, like "Downloads" but I have to open a folder in a shared drive and then copy the info of this workbook and paste in another file.
'Force the explicit declaration of variables
Option Explicit
Sub OpenLatestFile()
'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
'Specify the path to the folder
MyPath = "P:\GTS\zdss\"
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.xls", vbNormal)
'If no files were found, exit the sub
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each Excel file in the folder
Do While Len(MyFile) > 0
'Assign the date/time of the current file to a variable
LMD = FileDateTime(MyPath & MyFile)
'If the date/time of the current file is greater than the latest
'recorded date, assign its filename and date/time to variables
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
'Get the next Excel file from the folder
MyFile = Dir
Loop
'Open the latest file
Workbooks.Open MyPath & LatestFile
End Sub
Here are 3 ideas. I am not sure whether one will solve your problem but maybe it could help you.
1) I have found this discussion on a forum (http://www.vbaexpress.com/forum/showthread.php?19669-Workbooks-Open-using-network-path). In my understanding, the problem seems close to your. Maybe try to use the few lines using to manage errors (begin by On Error Resume next).
2) I think you have already verified but the extension of the file is ".xls", not ".xlsx" ?
3) Doing operations on dates in VBA needs particular functions. Here, you are doing a comparison as if it is integers (LMD > LatestDate). Moreover, I am not sure that LatestDate will have a proper value, because you never define it in the beginning. I suggest to change the code in this way. First define LatestDate before the While statement with an arbitrary low value (so, you are sure that the variable has a value and the If LMD > LatestDate statement will work properly).
LatestDate = Format("01.01.1900", "dd.mm.yyyy")
Second, change the If LMD > LatestDate statement :
If DateDiff("d",LatestDate,LMD) > 0 Then
Of course, you need to change the parameter "d" (for day) in case you want a comparison in other unit.
Cheers.
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
I have a Macro that gets sub folder data. However I also want something from the main folder.
I looked at How to get current working directory using vba? but need to change activeworkbook path:
Application.ActiveWorkbook.Path might be "c:\parent\subfolder"
I would want
"c:\parent\"
Using Excel 365 VBA
As the path may not be the current working directory you need to extract the path from the string.
Find the last \ and read all characters to the left:
ParentPath = Left$(Path, InStrRev(Path, "\"))
If you are working around the current directory ChDir ".." will jump you up one level, the new path can be returned by CurrDir.
The most reliable way to do this is to use the Scripting.FileSystemObject. It has a method that will get the parent folder without trying to parse it:
With CreateObject("Scripting.FileSystemObject")
Debug.Print .GetParentFolderName(Application.ActiveWorkbook.Path)
End With
Dim WbDir As String
Dim OneLvlUpDir As String
'get current WorkBook directory
WbDir = Application.ActiveWorkbook.Path
'get directory one level up
ChDir WbDir
ChDir ".."
'print new working directory and save as string. Use as needed.
Debug.Print CurDir()
OneLvlUpDir = CurDir()
I think you mean this solution:
Sub t()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
MsgBox "ThisWorkbook.Path = " & ThisWorkbook.Path & vbLf & _
"Path one folder down = " & fso.GetFolder(ThisWorkbook.Path & "\." & "NewFolder").Path
Set fso = Nothing
End Sub
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
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.