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
Related
I have many macros that have the following path definition:
"X:\Test\3rd Party\Other Files\"
But what I need to, which is what I did with the vbscripts, is make it like this:
"\\ServerName\Folder\Test\3rd Party\Other Files\"
This is because the files that have the macros in them are on the server and they need to be able to be executed by anyone who has access to the server - and since each person might map the drive with a different letter and/or have different levels of access, the first option wont work.
When I use this:
"\\ServerName\Folder\Test\3rd Party\Other Files\"
I get the error:
Sorry, we couldn't find \ServerName\Folder\Test\3rd Party\Other
Files. Is it possible it was moved, renamed or deleted?
When I use this:
"\\ServerName\Folder\Test\3rd Party\Other Files"
Note the backslash missing at the end of the string
I get the error:
Excel cannot access "Other Files". The document may be read-only or
encrypted.
Sub RenameOriginalFilesSheets()
Const TestMode = True
Dim WB As Workbook
Application.ScreenUpdating = False
rootpath = "\\ServerName\Folder\Test\Terminations\"
aFile = Dir(rootpath & "*.xlsx")
Do
Set WB = Application.Workbooks.Open(rootpath & aFile, False, AddToMRU:=False)
WB.Sheets(1).Name = Left$(WB.Name, InStrRev(WB.Name, ".") - 1)
WB.Close True
aFile = Dir()
DoEvents
Loop Until aFile = ""
Application.ScreenUpdating = True
End Sub
Try this, I test in VBA and it works.
Sub serverfolder()
Dim StrFile As String
StrFile = Dir("\\ServerIP\Folder\" & "*")
Do While StrFile <> ""
StrFile = Dir
Loop
End Sub
I've been trying to do something REALLY simple here but, for whatever the reason, it's not working.
All that I'm trying to do is to get all the .txt files from a specific directory using a wildcard.
Here is the full code that I'm using:
Sub RenameFiles()
'Variables Declaration
Dim vSpreadsheetPath As String
Dim vFolderName As String
Dim vFilesPath As String
Dim vFile As String
Dim vRow As Long
Dim vFilter As String
'Getting the vFile path
vSpreadsheetPath = ActiveWorkbook.Path
vFolderName = "COMBINED FOLDER"
vFilter = "*.txt"
vFilesPath = vSpreadsheetPath & Application.PathSeparator & vFolderName & Application.PathSeparator
vFile = Dir(vFilesPath & vFilter)
MsgBox (vFile)
End Sub
But nothing shows in the result.
The weirdest thing is:
If I use
file = Dir(vFilesPath & "filename.txt")
It works
But if I try to use any Wildcard, like the one bellow, it doesn't.
file = Dir(vFilesPath & "filename.t*")
Any idea of what I might be doing wrong?
It is relevant that you're on a Mac since Mac's don't use wildcards like Windows.
You'll need a different approach or a new (re-worded) question for more information about handling the Mac file system with VBA.
This should help get you started.
(Posted as an answer by O.P. request.) :-)
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 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.
i think this will be really basic and i have tried to refer to multiple threads (How to use file path from a cell in VBA?). But cant seem to get any code working without any issues.
Basically what i want to do is open different XL files dependent on an input from a cell, all the files are in the same location (folder), but obviously the name will alter. So in cell C3 i write a number e.g. 12345 and i want it to look in a constant folder for the corresponding named XL document.
All files are saved in C:\ ***** \ *****\Documents\My Work, i want to open the folder C:\ ***** \ *****\Documents\My Work\12345.XLS which changes dependent on C3.
Here is the code i attempted to use:
Sub Macro()
Dim Filelocation As String
Dim File As String
Dim Filepathfull As String
Filelocation = "C:\ ***** \ *****\Documents\My Work"
File = "C3"
Filepathfull="Filelocation & "\" & "File" & ".xlsx"
Workbooks.Open(Filename:=Filepathfull)
End Sub
Ill keep looking in the meantime! thanks for your help in advance.
EDIT WITH ANSWER:
Sub Macro()
Dim Filelocation As String
Dim File As String
Dim Filepathfull As String
Filelocation = "C:\ ***** \ *****\Documents\My Work"
File = "C3"
Filepathfull = Filelocation & "\" & Range(File).Value & ".xlsx"
Workbooks.Open (Filepathfull)
End Sub
Try this (Untested)
Filepathfull= Filelocation & "\" & Sheets("Sheet1").Range(File).Value & ".xls"
Filelocation and File are variables. Treat them as such. Anything that you put in quotes will be considered as a string.
In the above code change Sheet1 to the relevant sheet. i.e the sheet where the file names are.