Stackbros
I have some VBA which I'm using to import a .csv file from a specified folder into Excel. Once imported the script performs some other transformations such as delimiting and offsetting. See below.
Sub OpenTextFile ()
Dim FilePath As String
FilePath = "C:\Foldername\Foldername\Foldername\File_name.CSV"
Open FIlePath For Input As #1
row_number = 0
Do Until EOF(1)
Line Input #1, LineFromFile
LineItems = Split(LineFromFile, ",")
ActiveCell.Offset (row_number, 0).Value = LineItems (2)
ActiveCell.Offset (row_number, 1).value = LineItems (1)
ActiveCell.Offset (row_number, 2).Value = LineItems (0)
row_number = row_number + 1
Loop
Close #1
End Sub
What I really want to do is modify this so that when I run this I'm alsways importing the latest file from the folder, based on the date property of the file in the folder.
Thanks in advance.
Have a look at this routine. It is rather old but I think it does what you want. If not, it should give you some ideas.
Function NewestFileName(ByVal Path As String, ByVal FileTemplate As String) As String
' * Path Folder in which to search for files
' * FileTemplate File name specification of the file required. For example:
' MyFile*.xls
' * Finds, and returns the name of, the newest file in folder Path with a name
' that matches FileTemplate. Returns "" if no matching file is found.
' 25Jul11 Copied from RiskRegisterControl V43.xls.
' 22Nov11 Name changed from NewestFile to NewestFileName to match NextFileName.
' 20Apr12 Minor improvements
Dim FileDateCrnt As Date
Dim FileDateNewest As Date
Dim FileNameCrnt As String
Dim FileNameNewest As String
If Right(Path, 1) <> "\" Then
Path = Path & "\"
End If
FileNameCrnt = Dir$(Path & FileTemplate)
If FileNameCrnt = "" Then
NewestFileName = ""
Exit Function
End If
FileNameNewest = FileNameCrnt
FileDateNewest = FileDateTime(Path & FileNameCrnt)
Do While True
FileNameCrnt = Dir$
If FileNameCrnt = "" Then Exit Do
FileDateCrnt = FileDateTime(Path & FileNameCrnt)
If FileDateCrnt > FileDateNewest Then
FileNameNewest = FileNameCrnt
FileDateNewest = FileDateCrnt
End If
Loop
NewestFileName = FileNameNewest
End Function
Related
I am a new to VBA. My issue is that I have a file that will be updated it into a specific folder by different users. Now everytime a user updates the file, the name of the file might not be the samefolder. However, I can narrow it down using specific keywords. I have been able to search for a file using a keyword but not multiple keywords. Please can you point me in the right direction on how I can use multiple keywords to find a file in a folder? Is it possible to write code that will work like the below?
Sub Start_countries()
Dim keyword, pathname, filename As String
pathname = "C:\XYZ\"
keyword = "lol" Or "rofl" Or "lmfao" Or "rotfl"
filename = Dir(pathname & "*.xls*")
Do While filename <> "*.xls*"
If LCase(filename) Like "*" & keyword & "*" Then
Set wb = Workbooks.Open(pathname & filename)
Find_count_sum_in_file filename
wb.Close SaveChanges:=True
Else
msgbox = "No file Found"
End If
Loop
End Sub
Try the following (adapted following your comment):
Private Const MAX_KWD = 5 ' use a constant to make sure everyone uses the same value
Sub Start_countries()
Dim keyword(1 To MAX_KWD), pathname As String
'Keywords for first file search
keyword(1) = "lol"
keyword(2) = "rofl"
keyword(3) = "lmfao"
keyword(4) = "rotfl"
pathname = "C:\XYZ1\"
search_for_files keyword(), pathname
'Keywords for second file search
keyword(1) = "omg"
keyword(2) = "fyi"
keyword(3) = "ok"
keyword(4) = "brb"
pathname = "C:\XYZ2\"
search_for_files keyword(), pathname
End Sub
Sub search_for_files(keyword(), pathname)
Dim filename As String, s As String
Dim i As Integer
filename = Dir(pathname & "*.xls*")
Do While InStr(filename, ".xls") <> 0
s = LCase(filename)
For i = 1 To MAX_KWD
If (InStr(s, keyword(i)) > 0) Then Exit For ' found!
Next i
If (i <= MAX_KWD) Then
Set WB = Workbooks.Open(pathname & filename)
Find_count_sum_in_file filename
WB.Close SaveChanges:=True
Else
MsgBox "No file Found"
End If
filename = Dir()
Loop
End Sub
Note that in Dim pathname, filename, s As String only s is declared as String; all others are declared as Variant (the As String does not apply to all variables declared on the line).
Note also that in your While filename <> "*.xls*" the test will be exact, i.e. it will look also for asterisks (*) in filename.
I'm trying to figure out a line of code to open a file.
The path is constant, that is
"H:\silly\goose\*filename.xlsm*"
However, this file name will change each time I try to run this macro. This is because I will be using this macro to automate a report which I run weekly. Each report is saved with the date in the title and all reports are kept in the same folder, meaning I can't just start naming them all the same.
Examples:
H:\silly\goose\Report 06-03-15.xlsm
H:\silly\goose\Report 05-27-15.xlsm
The only helping piece of information is that this report is to be run every Wednesday. Therefore, each filename will have a difference of 7 days. I don't know if there is anything I can do with the Date method here, though.
What you need to do is re-construct your file name first.
Const fpath As String = "H:\silly\goose\" ' your fixed folder
Dim fname As String
' Below gives you the Wednesday of the week
fname = Format(Date - (Weekday(Date) - 1) + 3, "mm-dd-yy") ' returns 06-03-15 if run today
fname = "Report " & fname & ".xlsm" ' returns Report 06-03-15.xlsm
fname = fpath & fname ' returns H:\silly\goose\Report 06-03-15.xlsm
Then execute opening of the file:
Dim wb As Workbook
Set wb = Workbooks.Open(fname)
If wb Is Nothing Then MsgBox "File does not exist": Exit Sub
' Rest of your code goes here which works on wb Object
This reference has this function:
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function
Now you can do:
p = "H:\silly\goose\*.xlsm"
x = GetFileList(p)
And get the file you want
I'm trying to create a macro that reads each *.txt file from a folder, and if the modification date matches the current one, copy the contents into a worksheet of the *.xls file. I've been checking a lot of the codes you have been sharing here, but I just can't make it work.
When debbuging, at the 8th line, I get an error:
438: Object doesn't support this property or method
Sub GetSAPfiles()
Dim Cont As Integer
Dim RootDir As String
RootDir = "\HOME\SAP\dir\"
SAPfile = Dir(RootDir)
Set SAPfile = CreateObject("Scripting.FileSystemObject")
Set SF = SAPfile.GetFile(RootDir + SAPfile)
Do While SAPfile <> ""
Dim ObjDate, CurrDate
CurrDate = Format(Now(), "MM/DD/YYYY")
ObjDate = Format(file.DateLastModified, "MM/DD/YYYY")
If CurrDate = ObjDate Then
Cont = Cont + 1
Dim TxtFl, Txt
Set TxtFl = SAPfile.OpenTextFile(RootDir + SAPfile)
Txt = TxtFl.ReadLine
ActiveSheet.Cells(Cont, "A").Value = Txt
ArchTxt.Close
End If
SAPfile = Dir(RootDir)
Loop
End Sub
Try something like this instead, use the command prompt to get an array of files and loop through them using the FSO to check the modified date and read the text into the next blank cell in column A:
Sub SO()
RootDir$ = "\HOME\SAP\dir\"
For Each x In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR " & RootDir & "*.* /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
With CreateObject("Scripting.FileSystemObject")
If DateValue(.GetFile(RootDir & x).DateLastModified) = Date Then _
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = .OpenTextFile(RootDir & x, 1).ReadAll
End With
Next x
End Sub
This code uses Dir to get sub-dirs. Each sub-dir needs to have its xls files processed. After it finishes processing the first batch of xls, I get invalid procedure call or argument. I am guessing when I pass dirLook to the function it creates a copy? Please assist. I need to move on to the next sub-dir.
dirLook = dir(strDir, vbDirectory)
Do While dirLook <> ""
If dirLook <> "." And dirLook <> ".." Then
If (GetAttr(strDir & adir) And vbDirectory) = vbDirectory Then
'Perform action on folder here
loopXls (dirLook)
Debug.Print dirLook
End If
End If
dirLook = dir
Loop
loopXls:
Function loopXls(dirStr As String)
Dim count As Integer
Dim strFilename As String
Dim strPath As String
Dim wbkTemp As Workbook
strPath = "C:\Users\pmevi\Documents\L7\L7_Master_Book\Input\" & dirStr & "\"
strFilename = dir(strPath & "*.xls")
Do While Len(strFilename) > 0
Set wbkTemp = Workbooks.Open(strPath & strFilename)
'
' do your code with the workbook
'
' save and close it
wbkTemp.Close True
count = count + 1
strFilename = dir
Loop
Debug.Print (count)
End Function
EDIT2
I am attemping to load each dir into an array, but for some reason when I loop through array I only see 3 folders instead of 5.
Dim dirs(5) As String
Dim i As Integer
Dim endNum As Integer
endNum = 4
dirLook = dir(strDir, vbDirectory)
For i = 0 To endNum
dirs(i) = dirLook
dirLook = dir
Next i
For i = 0 To endNum
Debug.Print (dirs(i))
Next i
output:
3-10-14
3-11-14
3-12-14
expected:
3-10-14
3-11-14
3-12-14
3-13-14
3-14-14
Edit3
Found issue to array. 2 indexes are used for "." and ".."
It's not exactly clear from the code, but if the code above is in the loopXls method, making this a recursive function then the problem is that you cannot use the Dir function recursively, as stated here, towards the bottom.
The answer here include shows an example class for recursing with the Dir function.
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.