How do I extract the filename myfile.pdf from C:\Documents\myfile.pdf in VBA?
The best way of working with files and directories in VBA for Office 2000/2003 is using the scripting library.
Create a filesystem object and do all operations using that.
Early binding:
Add a reference to Microsoft Scripting Runtime (Tools > References in the IDE).
Dim fso as new FileSystemObject
Dim fileName As String
fileName = fso.GetFileName("c:\any path\file.txt")
Late binding (see comments for more)
With CreateObject("Scripting.FileSystemObject")
fileName = .GetFileName(FilePath)
extName = .GetExtensionName(FilePath)
baseName = .GetBaseName(FilePath)
parentName = .GetParentFolderName(FilePath)
End With
The FileSystemObject is great. It offers a lot of features such as getting special folders (My documents, etc.), creating, moving, copying, deleting files and directories in an object oriented manner.
Dir("C:\Documents\myfile.pdf")
will return the file name, but only if it exists.
This is taken from snippets.dzone.com:
Function GetFilenameFromPath(ByVal strPath As String) As String
' Returns the rightmost characters of a string upto but not including the rightmost '\'
' e.g. 'c:\winnt\win.ini' returns 'win.ini'
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function
I've read through all the answers and I'd like to add one more that I think wins out because of its simplicity. Unlike the accepted answer this does not require recursion. It also does not require referencing a FileSystemObject.
Function FileNameFromPath(strFullPath As String) As String
FileNameFromPath = Right(strFullPath, Len(strFullPath) - InStrRev(strFullPath, "\"))
End Function
http://vba-tutorial.com/parsing-a-file-string-into-path-filename-and-extension/ has this code plus other functions for parsing out the file path, extension and even the filename without the extension.
I can't believe how overcomplicated some of these answers are... (no offence!)
Here's a single-line function that will get the job done:
Function getFName(pf)As String:getFName=Mid(pf,InStrRev(pf,"\")+1):End Function
Function getPath(pf)As String:getPath=Left(pf,InStrRev(pf,"\")):End Function
Examples:
Dim sFilePath$, sFileName$
sFileName = Split(sFilePath, "\")(UBound(Split(sFilePath, "\")))
If you want a more robust solution that will give you both the full folder's path AND the filename, here it is:
Dim strFileName As String, strFolderPath As String
Dim lngIndex As Long
Dim strPath() As String
strPath() = Split(OpenArgs, "\") 'Put the Parts of our path into an array
lngIndex = UBound(strPath)
strFileName = strPath(lngIndex) 'Get the File Name from our array
strPath(lngIndex) = "" 'Remove the File Name from our array
strFolderPath = Join(strPath, "\") 'Rebuild our path from our array
Or as a sub/function:
Private Sub SeparatePathAndFile(ByRef io_strFolderPath As String, ByRef o_strFileName As String)
Dim strPath() As String
Dim lngIndex As Long
strPath() = Split(io_strFolderPath, "\") 'Put the Parts of our path into an array
lngIndex = UBound(strPath)
o_strFileName = strPath(lngIndex) 'Get the File Name from our array
strPath(lngIndex) = "" 'Remove the File Name from our array
io_strFolderPath = Join(strPath, "\") 'Rebuild our path from our array
End Sub
You pass the first parameter with the full path of the file and it will be set to the folder's path while the second parameter will be set to the file's name.
Here's a simple VBA solution I wrote that works with Windows, Unix, Mac, and URL paths.
sFileName = Mid(Mid(sPath, InStrRev(sPath, "/") + 1), InStrRev(sPath, "\") + 1)
sFolderName = Left(sPath, Len(sPath) - Len(sFileName))
You can test the output using this code:
'Visual Basic for Applications
http = "https://www.server.com/docs/Letter.txt"
unix = "/home/user/docs/Letter.txt"
dos = "C:\user\docs\Letter.txt"
win = "\\Server01\user\docs\Letter.txt"
blank = ""
sPath = unix
sFileName = Mid(Mid(sPath, InStrRev(sPath, "/") + 1), InStrRev(sPath, "\") + 1)
sFolderName = Left(sPath, Len(sPath) - Len(sFileName))
Debug.print "Folder: " & sFolderName & " File: " & sFileName
Also see: Wikipedia - Path (computing)
The simplest approach if you are sure the file physically exists on the disk:
Dim fileName, filePath As String
filePath = "C:\Documents\myfile.pdf"
fileName = Dir(filePath)
If you are not sure about existence of file or just want to extract filename from a given path then, simplest approach is:
fileName = Mid(filePath, InStrRev(filePath, "\") + 1)
To get the file name in an excel macro is:
filname = Mid(spth, InStrRev(spth, "\", Len(spth)) + 1, Len(spth))
MsgBox Mid(filname, 1, InStr(filname, ".") - 1)
Function file_name_only(file_path As String) As String
Dim temp As Variant
temp = Split(file_path, Application.PathSeparator)
file_name_only = temp(UBound(temp))
End Function
here you give your file name as input of the function
the split function of VBA splits the path in different portion by using "\" as path separator & stores them in an array named "temp"
the UBound() finds the max item number of array and finally assigns the result to "file_name_only" function
Hope this will be helpful.
Here's an alternative solution without code. This VBA works in the Excel Formula Bar:
To extract the file name:
=RIGHT(A1,LEN(A1)-FIND("~",SUBSTITUTE(A1,"\","~",LEN(A1)-LEN(SUBSTITUTE(A1,"\","")))))
To extract the file path:
=MID(A1,1,LEN(A1)-LEN(MID(A1,FIND(CHAR(1),SUBSTITUTE(A1,"\",CHAR(1),LEN(A1)-LEN(SUBSTITUTE(A1,"\",""))))+1,LEN(A1))))
I am using this function...
VBA Function:
Function FunctionGetFileName(FullPath As String) As String
'Update 20140210
Dim splitList As Variant
splitList = VBA.Split(FullPath, "\")
FunctionGetFileName = splitList(UBound(splitList, 1))
End Function
Now enter
=FunctionGetFileName(A1) in youe required cell.
or You can use these...
=MID(A1,FIND("*",SUBSTITUTE(A1,"\","*",LEN(A1)-LEN(SUBSTITUTE(A1,"\",""))))+1,LEN(A1))
I needed the path, not the filename.
So to extract the file path in code:
JustPath = Left(sFileP, Len(sFileP) - Len(Split(sFileP, "\")(UBound(Split(sFileP, "\")))))
This gleaned from Twiggy # http://archive.atomicmpc.com.au and other places:
'since the file name and path were used several times in code
'variables were made public
Public FName As Variant, Filename As String, Path As String
Sub xxx()
...
If Not GetFileName = 1 Then Exit Sub '
...
End Sub
Private Function GetFileName()
GetFileName = 0 'used for error handling at call point in case user cancels
FName = Application.GetOpenFilename("Ramp log file (*.txt), *.txt")
If Not VarType(FName) = vbBoolean Then GetFileName = 1 'to assure selection was made
Filename = Split(FName, "\")(UBound(Split(FName, "\"))) 'results in file name
Path = Left(FName, InStrRev(FName, "\")) 'results in path
End Function
Dim nme As String = My.Computer.FileSystem.GetFileInfo(pathFicheiro).Name
Dim dirc As String = My.Computer.FileSystem.GetFileInfo(nomeFicheiro).Directory
Related
I need to open a file whose full filename I do not know.
I know the file name is something like.
filename*esy
I know definitely that there's only one occurrence of this file in the given directory.
filename*esy is already a "shell ready" wildcard & if thats alway the case you can simply;
const SOME_PATH as string = "c:\rootdir\"
...
Dim file As String
file = Dir$(SOME_PATH & "filename*esy" & ".*")
If (Len(file) > 0) Then
MsgBox "found " & file
End If
Just call (or loop until empty) file = Dir$() to get the next match.
There is an Application.FileSearch you can use (see below). You could use that to search for the files that match your pattern. This information taken from here.
Sub App_FileSearch_Example()
With Application.FileSearch
.NewSearch
.LookIn = "c:\some_folder\"
.FileName = "filename*esy"
If .Execute(SortBy:=msoSortByLastModified, SortOrder:=msoSortOrderDescending) > 0 Then
For i1 = 1 To .FoundFiles.Count
' do something with matched file(s)
Next i1
End If
End With
End Sub
If InStr(sFilename, "filename") > 0 and InStr(sFilename, "esy") > 0 Then
'do somthing
end if
Or you can use RegEx
Dim RE As Object, REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "filename(.*)esy"
End With
Set REMatches = RE.Execute(sFilename)
REMatches(0) 'find match
I was trying this question as a function. This is the solution that ended up working for me.
Function fileName(path As String, sName As String, ext As String) As Variant
'path is Full path from root. Can also use path = ActiveWorkbook.path & "\"
'sName is the string to search. ? and * are wildcards. ? is for single char
'example sName = "book?" or sName ="March_*_2014*"
'ext is file extention ie .pdf .xlsm .xls? .j*
Dim file As Variant 'Store the next result of Dir
Dim fname() As String 'Dynamic Array for result set
ReDim fname(0 To 0)
Dim i As Integer ' Counter
i = 0
' Use dir to search and store first result
fname(i) = path & Dir(path & "\" & sName & ext)
i = i + 1
'Load next result
file = Dir
While file <> "" 'While a file is found store that file in the array
ReDim Preserve fname(0 To i) As String
fname(i) = path & file
file = Dir
Wend
fileName = Application.Transpose(fname) 'Print out array
End Function
This works for me as a single or array function.
If you know that no other file contains "filename" and "esy" in that order then you can simply use
Workbooks.Open Filename:= "Filepath\filename*esy.*"
Or if you know the number of missing characters then (assuming 4 characters unknown)
Workbooks.Open Filename:= "Filepath\filename????esy.*"
I use this method to run code on files which are date & timestamped to ignore the timestamp part.
I am currently working on a project that requires me to compile data from hundreds of spreadsheets in a given directory. My problem is I'm not sure how to handle different sub-revisions of files. For example the files are named:
File Name R1a.xlsx
File Name R1b.xlsx
File Name R1c.xlsx
File Name R2a.xlsx
File Name R2b.xlsx
For the above files I would only need to read from 1c and 2b. Is there a good way of determining which files need read, or could someone at least point me in a direction that I could look into? My initial thoughts were to loop through the characters in the file names and check for the largest letter that follows a number, but that seems like it would be incredibly tricky to code properly.
Thanks in advance!
There are a number of ways to approach this problem. If your filename domain is truly fixed as R{num}{prio}.xlsx, then note that the filenames constitute valid Excel cell addresses when {prio}.xlsx is stripped away. The resultant cell addresses from your example are R1 and R2. You can now use the R column of the current spreadsheet as a sparse vector to store the highest priority observed per cell (aka file). When all filenames have been examined and their highest priorities stored, it's now a simple matter of traversing the R column to pick up the files selected for processing.
Here's code that handles the aforementioned filename domain....
Sub ProcessFilesBasedOnFnamePriority()
Dim filenames, fname As Variant
Dim maxRowNum, nRowNum, i As Long
Dim strFilePrefix, strCellPrio As String
maxRowNum = 1
filenames = listfiles("c:\temp\lots_of_files")
' make an assumption that all filenames begin with the same
' single-char prefix character.
strFilePrefix = Left(filenames(1), 1)
For Each fname In filenames
Dim dotpos, suffixLen As Integer
Dim strCellAddr, strFnamePrio
dotpos = InStr(1, fname, ".")
suffixLen = Len(Mid(fname, dotpos))
' assume priority is specified by a single char in fname
strFnamePrio = LCase(Mid(fname, dotpos - 1, 1))
strCellAddr = Left(fname, Len(fname) - (suffixLen + 1)) ' "+1" to account for priority char
strCellPrio = Range(strCellAddr)
If (Trim(strCellPrio) = "") Then
Range(strCellAddr) = strFnamePrio ' store first prio occurrence
Else
' assume filename prio characters (e.g., [a-z]) sort lexicographically
If strFnamePrio > strCellPrio Then
Range(strCellAddr) = strFnamePrio
End If
End If
nRowNum = CLng(Mid(strCellAddr, 2))
If nRowNum > maxRowNum Then
maxRowNum = nRowNum
End If
Next
For i = 1 To maxRowNum
strCellPrio = Trim(Range(strFilePrefix & CStr(i)))
If strCellPrio <> "" Then
fname = strFilePrefix & CStr(i) & strCellPrio & ".xlsx"
Debug.Print fname ' <-- do analysis on fname
End If
Next i
End Sub
The code for listfiles is here. Note that this solution will not handle stray files that don't follow the assumed naming pattern. You'll need to add checks to weed them out.
You can store your list of partial file names you need to match in an array. Then loop through the partial names in the array and foreach partial name, loop through the directory to look for a match. VBA provides the InStr function to that you can use to test if a file name contains the partial name from your array.
In pseudocode:
myArray = [ 1c, 2b]
ForEach partialName in myArray
ForEach file in myDirectory
If InStr(fileName, partialName) Then
// Do something interesting
End If
Next file
Next partialName
Use a excel sheet or tabular format to express the file desired.
The excel sheet only needs two columns, A for the filename without the sub-revision, and column B for the desired sub-revision.
Compile and compose this information and then your vba implementation use the excel worksheet/tabular format to iterate and read "only" those files.
Use whatever language to compose the tabular format (in my case, python is preferred) and try to use any thing you can "to determine the sub-revision".
This allows you to debug the results more easily and use whatever language to compile a worksheet formatted or tabular delimited file.
This works because .GetFolder returns a sorted list.
Option Explicit
Sub FilesSelecter()
Dim fs As Object
Dim TargetPath As String
Dim DirList As Object
Dim File As Object
Dim BaseName As String
Dim RootFileName As String
Dim SaveRootFileName As String
Dim SaveBaseName As String
Set fs = CreateObject("Scripting.FileSystemObject")
TargetPath = "C:\Users\BeastMstr\Documents\TestFiles"
Set DirList = fs.Getfolder(TargetPath)
SaveRootFileName = ""
For Each File In DirList.Files
BaseName = fs.getbasename(File)
RootFileName = Left(BaseName, Len(BaseName) - 1)
If SaveRootFileName = RootFileName Or SaveRootFileName = "" Then
SaveRootFileName = RootFileName
SaveBaseName = BaseName
Else
'
'Do Somethingwith SaveBaseName
'
Debug.Print SaveBaseName
SaveRootFileName = RootFileName
SaveBaseName = BaseName
End If
Next
'
' Do something with the last file
'
Debug.Print SaveBaseName
End Sub
I have an excel workbook that is stored locally on my PC but inside my OneDrive sync-ed folder. Whenever I try (from the immediate window and programmatically as well):
? Excel.Application.ThisWorkbook.FullName
I get something like:
https://d.docs.live.net/c31ceb5b47a36fa2/VBA/learnVBAmacros.xlsb
whereas the real local path of my file is:
C:\Users\viset\OneDrive\VBA\learnVBAmacros.xlsb
How can I retrieve this latter LOCAL path to my workbook, instead of its URL on OneDrive?
Simply go to your one drive settings and untick the "Use office applications to sync...."
enter image description here
Split off the filename and use environment variables for your local OneDrive folder.
dim fn as string
fn = ThisWorkbook.FullName
'split off the workbook name if fullname is a url
fn = split(fn, "/")(ubound(split(fn, "/")))
'split off the workbook name if fullname is a local path
fn = Split(fn, "\")(UBound(Split(fn, "\")))
'add the environment var
fn = environ("onedrive") & "\" & fn
'check to see if it exists
if len(dir(fn)) > 0 then
debug.print fn
end if
Note that there are OneDrive and OneDriveConsumer environment variables. My own are identical but there must be a reason for each.
This works, sorry but I can not remember where I found it
Sub GetDocLocalPath_Test()
MsgBox GetDocLocalPath(ThisWorkbook.FullName)
End Sub
Function GetDocLocalPath(docPath As String) As String
'Gel Local Path NOT URL to Onedrive
Const strcOneDrivePart As String = "https://d.docs.live.net/"
Dim strRetVal As String, bytSlashPos As Byte
strRetVal = docPath & "\"
If Left(LCase(docPath), Len(strcOneDrivePart)) = strcOneDrivePart Then 'yep, it's the OneDrive path
'locate and remove the "remote part"
bytSlashPos = InStr(Len(strcOneDrivePart) + 1, strRetVal, "/")
strRetVal = Mid(docPath, bytSlashPos)
'read the "local part" from the registry and concatenate
strRetVal = RegKeyRead("HKEY_CURRENT_USER\Environment\OneDrive") & strRetVal
strRetVal = Replace(strRetVal, "/", "\") 'slashes in the right direction
strRetVal = Replace(strRetVal, "%20", " ") 'a space is a space once more
End If
GetDocLocalPath = strRetVal
End Function
Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object
On Error Resume Next
'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'read key from registry
RegKeyRead = myWS.RegRead(i_RegKey)
End Function
I had the same problem and the solution in very easy.
If your file is pending for synchronization on OneDrive you will have the value of ThisWorkBook.Path as an URL address.
Unless your file synchronizes the value of ThisWorkBook.Path will contain the local address of the file.
Combining a few earlier answers, I went with this function. It makes fewer assumptions about the format of a OneDrive URL and it uses the environment instead of the registry.
Note: it does still make assumptions about the OneDrive URL. Specifically:
Assumed to start with "https:"
Assumed only one URL path-component after the hostname
Assumed that what follows will match the local file-system
Function GetWorkbookDirectory() As String
Dim sPath As String
Dim sOneDrive As String
Dim iPos As Integer
sPath = Application.ActiveWorkbook.Path
' Is this a OneDrive path?
If Left(sPath, 6) = "https:" Then
' Find the start of the "local part" of the name
iPos = InStr(sPath, "//") ' Find start of URL hostname
iPos = InStr(iPos + 2, sPath, "/") ' Find end of URL hostname
iPos = InStr(iPos + 1, sPath, "/") ' Find start of local part
' Join that with the local location for OneDrive files
sPath = Environ("OneDrive") & Mid(sPath, iPos)
sPath = Replace(sPath, "/", Application.PathSeparator)
End If
GetWorkbookDirectory = sPath
End Function
I solved this using FileSystemObject.
Dim fso as FileSystemObject, localPath as String, localFullFileName as String
localPath = fso.GetParentFolderName(fso.GetAbsolutePathName(Application.ActiveWorkbook.Name))
localFullFileName = fso.GetAbsolutePathName(Application.ActiveWorkbook.Name)
I solved this using CurDir
Function GetFilePath() As String
GetFilePath = CurDir
End Function
I have an issue and I need your help. here is the problem. I have inside a folder some excel files that I have to open automatically in order to make some operations. Those files have the same name except the number of the files like this:
Folder name : Extraction_Files
Files name : - "System_Extraction_Supplier_1"
- "System_Extraction_Supplier_2"
- "System_Extraction_Supplier_3"
The number of files can change so i used a loop Do While to count the number of files, then the plan is to use a loop for I =1 to ( number of files) to open all of theme.
please read my code. I know that i used a wrong way to read file name using a loop for but I share it because I don't have an other idea.
Here is my code :
Sub OpenFiles ()
Dim MainPath as String
Dim CommonPath as String
Dim Count As Integer
Dim i As Integer
' the main path is " C:\Desktop\Extraction_Files\System_Extraction_Supplier_i"
'with i = 1 to Count ( file number )
CommonPath = "C:\Desktop\Extraction_Files\System_Extraction_Supplier_*"
'counting automatically the file number
Filename = Dir ( CommonPath )
Do While Filename <> ""
Count = Count + 1
Filename = Dir ()
Loop
'the issue is below because this code generate a MsgBox showing a MainPath with the index i like this
'"C:\Desktop\Extraction_Files\System_Extraction_Supplier_i"
' so vba can not find the files
For i = 1 To count
MainPath = "C:\Desktop\Extraction_Files\System_Extraction_Supplier_" & "i"
MsgBox MainPath &
Workbooks.Open MainPath
Next
End Sub
what is the best approach to this?
Why not count as you open them. You're already identifying them so why not open each file as you go:
Sub OpenFiles()
Dim Filename As String
Dim CommonPath As String
Dim Count As Integer
CommonPath = "C:\Desktop\Extraction_Files\"
Filename = Dir(CommonPath & "System_Extraction_Supplier_*")
Do While Filename <> ""
MsgBox Filename
Workbooks.Open CommonPath & Filename
Count = Count + 1
Filename = Dir()
Loop
End Sub
PS. It might be worth adding .xl* or similar to the end of your search pattern to prevent Excel trying to open files that aren't Excel files:
Filename = Dir(CommonPath & "System_Extraction_Supplier_*.xl*")
If you want to open all folders, in a specific folder, which start with "NewFile_", one loop only is needed:
Sub OpenFolders()
Dim path As String: path = ""C:\Desktop\Extraction_Files\""
Dim fileStart As String: fileStart = "System_Extraction_Supplier_"
Dim Fso As Object
Dim objFolder As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = Fso.GetFolder(path)
For Each objSubFolder In objFolder.subfolders
If InStr(1, objSubFolder.Name, fileStart) Then
Shell "explorer.exe " & objSubFolder, vbNormalFocus
Debug.Print objSubFolder.Name
End If
Next objSubFolder
End Sub
Folders in vba are opened with the Shell "explorer.exe " command. The code opens every folder in "C:\yourFile\", which contains NewFile_ in the name. This check is done with If InStr(1, objSubFolder.Name, fileStart) Then.
I need to make a loop that will save the edited files in a folder in numerical order, but if I run the macro again it needs to keep from the last number:
wb.SaveAs "C:\User\Desktop\Data\" & i & ".dat"
i = i + 1
Here the code saves the files in order (1,2,3). And if I run the macro again it needs to save (4,5,6).
I tried to use this loop above to save the function:
Do While Dir("C:\User\Desktop\Data\" & i & ".dat") = i
i = i + 1
Loop
But apparently, I can't use the DIR function, because I'm already using it at the end of the loop to get the next file, and the loop breaks.
'Get next file name
MyFile = Dir
So, is there's any way to do this? I'm trying to make a function that would check and return true or false to whether a file with that number already exists, but could not make it work. Thanks for the help.
You could get the largest number in the directory, and keep going from there?
This code presumes that all the files are named as such: [numericalfilename].[extension] for example "143.dat". This code will not work if there are alpha characters in the file-name (apart from extension)
Once you have defined Path and Extension variables, you can call the Function NextNumber which will give you [MaxNumber_In_Directory] + 1
From here you can perform your "save loop", by setting i = NextNumber(Path, "*." & Ext)
Sub test()
Dim Path As String
Dim Ext As String
Dim i as Long
' ***** REPLACE VARIABLES ******
Path = "C:\New\New Folder"
Ext = "dat"
' ******************************
i = NextNumber("C:\New\New Folder", "*." & Ext)
' ********************************
' **** PERFORM SAVE CODE HERE ****
' ********************************
'I am not 100% sure of your save loop, you'll need to modify this
wb.SaveAs "C:\User\Desktop\Data\" & i & ".dat"
i = i + 1
End Sub
Public Function NextNumber(strPath As String, strExt As String) As Long
Dim vArray(500)
Dim i As Long
Dim length As Long
ChDir strPath
strExtension = Dir(strExt)
'Perform Loop
Do While strExtension <> ""
length = Len(strExtension) - (Len(strExt) - 2) - 1
vArray(i) = CLng(Mid(strExtension, 1, length))
i = i + 1
strExtension = Dir
Loop
NextNumber = WorksheetFunction.Max(vArray) + 1
End Function