hi i want open the latest files in the folders when i run the below code getting run time error 1004, the issue is LatestFile hold the previous folder of latest excel file. note - code is opening the first two folders of latest file and then getting the error. please let me know how to fix the issue.
Sub Esskay()
Dim foldname, FolderName, subfold1, subfold2, strFilename As String
Dim FileName, myfile2, myFoldert As Workbooks
Dim sht, ws As Worksheet
Dim bottomMostRow As Long, rightMostColumn, Lastrow As Long
Dim FileSys, objFile, myFolder, c As Object
Dim misfile As Workbook
Dim rngLocation, rngLocation2 As Range
Dim rngNewCol As Range
Dim lrow, lrw, lcol As Long
Dim MyFiled As String
Dim LatestFile, Mypath As String
Dim LatestDate As Date
Dim LMD As Date
foldname = "C:\Users\ashokkumar.d\Desktop\Test\"
Lastrow = Workbooks("as").Sheets(1).Range("A" & Rows.count).End(xlUp).Row
For k = 2 To Lastrow
subfold1 = Workbooks("as").Sheets(1).Cells(k, 1).Value
subfold2 = Workbooks("as").Sheets(1).Cells(k, 2).Value
FolderName = (foldname + subfold1 + "\" + subfold2 + "\" + "MIS" + "\")
'Make sure that the path ends in a backslash
If Right(FolderName, 1) <> "\" Then FolderName = FolderName & "\"
'Get the first Excel file from the folder
MyFiled = Dir(FolderName & "*.xls")
'If no files were found, exit the sub
If Len(MyFiled) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each Excel file in the folder
Do While Len(MyFiled) > 0
'Assign the date/time of the current file to a variable
LMD = FileDateTime(FolderName & MyFiled)
'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 = MyFiled
LatestDate = LMD
End If
'Get the next Excel file from the folder
MyFiled = Dir
Loop
'Open the latest file
Set myfile2 = Workbooks.Open(FolderName & LatestFile)
next
end sub
Related
I am facing issues with VBA's looping through a list of files in a directory.
I need to loop through files which only have the word CITIES in the file name. But some times some files with the word CITIES might have a corresponding FINANCE file and hence I have to loop through the Folder again to find the finance file and extract information from it. I have written a funtion to get the file name if it exists and the biggest issue is the myFile = Dir which doesn't work as i hoped it would. I have the code which is here.
Sub getTheExecSummary()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
myPath = "C:\Users\MORPHEUS\Documents\Projects\"
myExtension = "*CITIES*.xls"
myFile = Dir(myPath & myExtension)
Debug.Print myFile
Do While Len(myFile) > 0
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
Dim prntStr As String
prntStr = wb.Worksheets("Sheet1").Cells(1, 1) & " (n= " _
& wb.Worksheets("Sheet2").Cells(12, 3) & ")"
Dim LookUpStr As String
LookUpStr = wb.Name
replaceStr = Left(LookUpStr, 10)
LookUpStr = Replace(LookUpStr, replaceStr, "")
Dim DoesTheFIleexist As String
DoesTheFIleexist = fileLoation(myPath, LookUpStr)
If (Len(DoesTheFIleexist) > 0) Then
Debug.Print (DoesTheFIleexist)
End If
Workbooks("ExecutiveSummary.xlsm").Sheets("Sheet1").Range("A1").Value = myFile
wb.Close SaveChanges:=False
'Get next file name
Debug.Print myFile
myFile = Dir
Loop
End Sub
Function fileLoation(filePath As String, LookUpStr As String) As String
Dim financeStr As String
Dim myFile1 As String
financeStr = "*FIN*.xls"
myFile1 = Dir(filePath & financeStr)
Do While Len(myFile1) > 0
Debug.Print ("")
Debug.Print (myFile1)
' If InStr(myFile1, LookUpStr) > 0 Then
' fileLoation = myFile1
' Else
' fileLoation = ""
' End If
myFile1 = Dir
Loop
End Function
The issue is that when the myFIle1 = Dir in the function finishes executing, the original myFile = Dir also is at its end (at least I think it is)
There is no way around this issue, that's just how the Dir Function works.
Instead, look into using a FileSystem object in the sub-function.
Alternatively, you can store all the filenames in the main function into an Array to loop thru instead of nesting your Dir functions like this:
Dim sFiles() as String
Dim sFilename as String
ReDim sFiles(0)
sFilename = Dir(myPath & "*CITIES*.xls")
Do Until sFilename = ""
ReDim Preserve sFiles(UBound(sFiles) + 1)
sFiles(UBound(sFiles)) = sFilename
sFilename = Dir()
Loop
Then you have found all your CITIES in a 1 based Array to loop thru.
Good afternoon,
I have tried searching different forums to no avail.
I have the below VBA code that will loop through all files in a folder and generate in a msge box the total number of rows of every file looped in that folder.
What I need your help on if possible is generate a summary report.
Ideally
The summary report will show File name and show how many rows with data in column H.
Sub LoopThroughFiles()
Dim folderPath As String
folderPath = ThisWorkbook.Path & "\"
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(folderPath & Filename, ReadOnly:=True)
For Each sh In wb.Sheets
If Application.CountA(sh.Range("H:H")) > 0 Then
myCount = myCount + sh.Range("H" & Rows.Count).End(xlUp).Row
End If
Next
wb.Close False
Filename = Dir
Set wb = Nothing
Loop
MsgBox myCount
End Sub
You could try opening a "home" workbook where all values are stored. Basically, what you'll need to do is open a new workbook, and during your loop through each of the files, you'll paste the file path and the row count in the new workbook. Hopefully this will help, or at least give you an idea of how to do what you're trying to do. `
Sub LoopThroughFiles()
Dim folderPath As String
Dim summarySheet as Workbook
set summarySheet = workbook.add
folderPath = ThisWorkbook.Path & "\"
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(folderPath & Filename, ReadOnly:=True)
For Each sh In wb.Sheets
If Application.CountA(sh.Range("H:H")) > 0 Then
myCount = myCount + sh.Range("H" & Rows.Count).End(xlUp).Row
End If
Next
wb.Close False
summarySheet.activate
Range("A:A").insert Shift:=xlDown
Cells(1,1) = Filename
Cells(1,2) = myCount
Filename = Dir
Set wb = Nothing
Loop
MsgBox myCount
End Sub`
I need a VBA where it updates the "name of the excel file" inside that particular "excel file". There are 12 files in the folder. The path for this folder is D:\Amit. Name of those 12 files are "Cash Report as on 11-05-2017 0000Hrs" starting from Midnight (that's why 0000Hrs) and it increases by 2 hours making it 0200Hrs, 0400Hrs etc. We prepare these files daily after every 2 hours. Sometimes it does happen that we run the file after 3 hours making it 0500Hrs instead of 0400Hrs just after 0200Hrs. What I need is a VBA file which opens all these 12 files and in column A in the last row of each respective file, it mentions the name of that particular file.
Eg. it should open all 12 files and then in the first file named Cash Report as on 11-05-2017, in the last row of column A of this file - it should mention the name of this particular file.
So if the VBA opened file "Cash Report as on 11-05-2017 0400Hrs" then in the last cell of the column A just after the text or data in the cell, using offset the very below blank cell should have the name of this file as "Cash Report as on 11-05-2017 0000Hrs". Likewise, need something like this for all the files which open up each individual file and update the respective file name inside the last row of column A.
I was trying some of the codes but it's still in bits and pieces.
Dim Source As String
Dim StrFile As String
'do not forget the last backslash in the source directory.
Source = "C:\Users\Admin\Desktop\VBA\"
StrFile = Dir(Source)
Do While Len(StrFile) > 0
Workbooks.Open Filename:=Source & StrFile
StrFile = Dir()
Loop
fldr = Activeworkbook.Path
Dt = Application.InputBox("Enter Date as 'dd-mm-yyyy' ", format(Now," dd-mm-yyyy"
Workbooks.open Filename:= fldr & "\Cash Report as on" & 0400 & "Hrs.xlsx"
Range("A1").End(xlDown).Select
Offset(1).Select
Try This
Sub t()
Dim Source As String
Dim StrFile As String
Dim wb As Workbook
'do not forget last backslash in source directory.
Source = "C:\Users\Admin\Desktop\VBA\"
StrFile = Dir(Source)
Do While Len(StrFile) > 0
Set wb = Workbooks.Open(Source & StrFile)
wb.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = wb.Name
StrFile = Dir()
wb.Close (True)
Loop
End Sub
Try something like this.
Assumptions:
The Excel file name will be pasted always in the first Sheet - in case the specific sheets are naming always in the same way change lines Sheets(1) with Sheets("YourName")
Every row in table from column A in Sheets(1) is not empty as I'm using COUNTA function (thx #Darren Bartrup-Cook)
Code:
Sub InsertFileName()
Dim strFolderPath As String
Dim lngLastRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim ErrNumbers As Integer
'Choose folder with Excel files
strFolderPath = GetFolder(ThisWorkbook.Path) & "\"
'Loop through all Excel files in FolderPath
FileName = Dir(strFolderPath & "*.xl*")
Do While FileName <> ""
'Open Excel file
Set WorkBk = Workbooks.Open(strFolderPath & FileName)
'Find the last row in A column
On Error Resume Next
lngLastRow = Application.WorksheetFunction.CountA(WorkBk.Sheets(1).Range("A:A")) + 1
If lngLastRow = 1 Then
ErrNumbers = ErrNumbers + 1
Err.Clear
GoTo NextWkb
End If
WorkBk.Sheets(1).Range("A" & lngLastRow).Value = WorkBk.Name
NextWkb:
'Close file and save changes
WorkBk.Close True
'Next file
FileName = Dir()
Loop
If ErrNumbers <> 0 Then
MsgBox "There were some problems with Excel files. Check if there is some empty sheet or empty A column in one or more Excel files and try again"
Else
MsgBox "Everything went fine!"
End If
End Sub
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
I have a folder "test" containing several dbf files. I would like vba to open them in excel file and save them (in excel format) in another folder keeping the same dbf file names.
I found this code on the net and am trying to use this code for my needs but it won't work. Error message:
"sub of function not defined"
...please look into it.
Sub test()
Dim YourDirectory As String
Dim YourFileType As String
Dim LoadDirFileList As Variant
Dim ActiveFile As String
Dim FileCounter As Integer
Dim NewWb As Workbook
YourDirectory = "c:\Users\navin\Desktop\test\"
YourFileType = "dbf"
LoadDirFileList = GetFileList(YourDirectory)
If IsArray(LoadDirFileList) = False Then
MsgBox "No files found"
Exit Sub
Else
' Loop around each file in your directory
For FileCounter = LBound(LoadDirFileList) To UBound(LoadDirFileList)
ActiveFile = LoadDirFileList(FileCounter)
Debug.Print ActiveFile
If Right(ActiveFile, 3) = YourFileType Then
Set NewWb = Application.Workbooks.Open(YourDirectory & ActiveFile)
Call YourMacro(NewWb)
NewWb.SaveAs YourDirectory & Left(ActiveFile, Len(ActiveFile) - 4) & ".xlsx"
NewWb.Saved = True
NewWb.Close
Set NewWb = Nothing
End If
Next FileCounter
End If
End Sub
You missing the functions GetFileList and YourMacro. A quick search brought me to this website (I think you copied it from there). http://www.ozgrid.com/forum/printthread.php?t=56393
There are the missing functions. Copy those two also in your modul to make it run (I tested it with pdf-Files):
Function GetFileList(FileSpec As String) As Variant
' Author : Carl Mackinder (From JWalk)
' Last Update : 25/05/06
' 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
NoFilesFound:
GetFileList = False
End Function
Sub YourMacro(Wb As Workbook)
Dim ws As Worksheet
Set ws = Wb.Worksheets(1)
ws.Range("A6").Value = "=((+A2*$CN2)+(A3*$CN3)+(A4*$CN4)+(A5*$CN5))/SUM($CN2:$CN5)"
ws.Range("A6").Copy ws.Range("B6:CM6")
ws.Range("CO6").Value = "=CO2"
End Sub
To save files in a different directory:
Dim SaveDirectory As String
SaveDirectory = "c:\Users\navin\Desktop\test\converted to excel"
Replace this line
NewWb.SaveAs YourDirectory & Left(ActiveFile, Len(ActiveFile) - 4) & ".xlsx"
with this
NewWb.SaveAs SaveDirectory & Left(ActiveFile, Len(ActiveFile) - 4) & ".xlsx"
I have the following code with a specific file name:
BD.Sheets("Sheet1").Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).Formula = "=SUMIF('P:\Actuary\Cash Flow Forecast\Annual and Quarterly Budget Data\[ECMQA 2012Q1.xls]Sheet1'!$D$13:$D$234,D2,OFFSET('P:\Actuary\Cash Flow Forecast\Annual and Quarterly Budget Data\[ECMQA 2012Q1.xls]Sheet1'!$D$13:$D$234,0,MATCH(E2,'P:\Actuary\Cash Flow Forecast\Annual and Quarterly Budget Data\[ECMQA 2012Q1.xls]Sheet1'!$D$12:$R$12,0)-1))"
However, I'm running a loop which goes into a folder and selects all the files within it (the file above is in that folder, I was testing my code out to see if it worked for one file):
Dim wb As Workbook, sFile As String, sPath As String
Dim itm As Variant
Dim strFileNames As String
sPath = "C:\Actuary\Cash Flow Forecast\Annual and Quarterly Budget Data\"
''Retrieve the current files in directory
sFile = Dir(sPath)
Do While sFile <> ""
strFileNames = strFileNames & "," & sFile
sFile = Dir()
Loop
''Open each file found
For Each itm In Split(strFileNames, ",")
If itm <> "" Then
Set wb = Workbooks.Open(sPath & itm)
''LOTS OF CALCULATIONS, INCLUDING ABOVE CODE
End If
Next itm
How would I write the first code if I don't know the file name (since it's looping through all of them)?
Any help will be appreciated!!
Sub WriteFormulas()
Dim sFile As String
Dim sPath As String
Dim sh As Worksheet
Dim rNext As Range
sPath = Environ("USERPROFILE") & "\My Documents\Tester\"
'Get the first file
sFile = Dir(sPath & "*.xls")
Do While Len(sFile) > 0
'don't process this workbook
If sFile <> ThisWorkbook.Name Then
'set a variable to the first sheet in the file
Set sh = Workbooks.Open(sFile).Worksheets(1)
'find the next available cell in column A in this workbook
Set rNext = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Offset(1, 0)
'create a formula using the address with the external argument
rNext.Formula = "=SUM(" & sh.Range("A1:A10").Address(True, True, xlA1, True) & ")"
'close the workbook
sh.Parent.Close False
End If
sFile = Dir
Loop
End Sub
When you close the workbook, Excel will expand the references to the full path and file name. So while Range("A1").Address(,,,true) might resolve to
[MyBook.xls]Sheet1!A1
when you close MyBook.xls, it will convert to
'C:\Path\[MyBook.xls]Sheet1'!A1