I need to copy 10 files from a folder to another folder on a daily basis depending on a specific date.
The date is in this format: "05/04/2021". Script is taking the date from a cell, however the Date modified is in this format in my explorer: "05/04/20221 00:00:00"
I tried to loop through the files but I can´t seem to match the last modified date of the 10 files in the folder with the date from the cell. I assume it has to do something with the format, but I can´t figure out what exactly.
I tried several approaches of formatting the date. Below is my last try. Any suggestions how I can fix this?
Sub copy_files()
Dim curr_path As String
Dim new_path As String
Dim r_date As Date
Dim wb As Workbook
Dim fname, fitem As String
Dim fdate As Date
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim FileItem As Scripting.File
curr_path = yourpath
new_path = yourpath
Set wb = Workbooks("Book1")
wb.Activate
r_date = Range("G2")
SourceFolderName = curr_path
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
i = 1
For Each FileItem In SourceFolder.Files
If FileItem.DateLastModified > r_date Then _
FileSystemObject.CopyFile new_path
i = i + 1
Next FileItem
Set FSO = Nothing
Related
Here is my problem, on my excel sheet I put paths of every folder that I want to check
V:\Folder1\
V:\Folder2\
Inside those folder I want vba to give me the name of the last modified file based on a specific name.
I will give an example:
In my folder1 I have those files :
Lo_2021_1
Lo_Full_2021_1
Lo_2021_2
Lo_Full_2021_2
...
Lo_2021_50
Lo_Full_2021_50
In my folder2 I have those files :
Li_2021_1
Li_Full_2021_1
Li_2021_2
Li_Full_2021_2
...
Li_2021_50
Li_Full_2021_50
I want vba to give me the name of the last modified file that starts with Lo_2021 in my folder1 and Li_2021 in my folder2 (so I don't want Lo_Full and Li_Full)
I already created a code that gave me the name of the last modified files but they are Lo_Full_2021_50 and Li_Full_2021_50 whereas I want Lo_2021_50 and Li_2021_50
Here is my code :
Option Explicit
Sub name_last_file()
Dim FileSys As FileSystemObject
Dim objFile As File
Dim myFolder
Dim strFilename As String
Dim dteFile As Date
Dim list_path As Range
Dim path_ As Range
Dim myDir As String
Set list_path = Range("B2", Range("B2").End(xlDown))
For Each path_ In list_path
myDir = path_.Value
'set up filesys objects
Set FileSys = New FileSystemObject
Set myFolder = FileSys.GetFolder(myDir)
'loop through each file and get date last modified. If largest date then store Filename
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If objFile.DateLastModified > dteFile Then
dteFile = objFile.DateLastModified
strFilename = objFile.Name
End If
Next objFile
MsgBox strFilename
Next path_
End Sub
This will give me Lo_Full_2021_50 and Li_Full_2021_50 whereas I want Lo_2021_50 and Li_2021_50.
Is there a way to say that I want the last modified file that start with Lo_2021 or Li_2020 so that I will get Lo_2021_50 and Li_2021_50 as a result ?
I'm really thankful for your help
Please, test the next updated code:
Sub Give_name_files()
Dim FileSys As FileSystemObject, objFile As File, myFolder As oobject
Dim strFilename As String, dteFile As Date, list_path As Range, path_ As Range
Dim strRoot As String
strRoot = "Lo_2021" 'the beginning of the tested files name
'First I Select paths that are on my excel cells
Set list_path = Range("B2", Range("B2").End(xlDown))
For Each path_ In list_path
myDir = path_.Value
'Set up filesys objects
Set FileSys = New FileSystemObject
Set myFolder = FileSys.GetFolder(myDir)
'loop through each file and get date last modified. If largest date then store Filename
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If left(objFile.Name, Len(strRoot)) = strRoot Then
If objFile.DateLastModified > dteFile Then
dteFile = objFile.DateLastModified
strFilename = objFile.Name
End If
End If
Next objFile
MsgBox strFilename
Next path_
End Sub
Set fso = CreateObject("Scripting.FileSystemObject")
Set froot = fso.GetFolder(strstartfldr)
For Each fldr In froot.SubFolders
UserForm1.ComboBox1.AddItem fldr.DateCreated
Next
at this program i can get the subfolder list in combbobox1
but from this subfolder how can i know which is last modified folder name
I'm sure there is simple code but cant figure out
anyone help
Last Folder (FSO)
The following function gets the name of the folder that was last created.
The Code
Option Explicit
Function LastFolder(FolderPath As String) As String
Dim fso As Object
Dim froot As Object
Dim fldr As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set froot = fso.GetFolder(FolderPath)
Dim fName As String
Dim fDC As Date
Dim TMP As Date
For Each fldr In froot.subfolders
TMP = fldr.DateCreated
If TMP > fDC Then
fDC = TMP
fName = fldr.Name
End If
Next fldr
LastFolder = fName
End Function
Sub testLastFolder()
Debug.Print LastFolder("F:\StackOverFlow")
End Sub
SO, this is some kind of example of what I am trying to do, VBA is doing like loop, opening some files, filter them and saves them..but thing is I would like to Specify date format in DD.MM.YYYY hh:mm in Column A (complete) as output. I dont know how to do that, tried something but it was always wrong output...
Sub Convert()
Dim FileSystem As Object
Dim HostFolder As String
' Folder with systems
HostFolder = "C:\Users\MirzaV\Desktop\Converter"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)
End Sub
Sub DoFolder(Folder)
Dim Workbook
Dim SubFolder
Dim date_test As Integer
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
' Operate on each file
Set Workbook = Workbooks.Open(File)
'MsgBox (Workbook.FileFormat)
If Workbook.FileFormat = -4158 Then
Set Workbook = Workbook.ActiveSheet
Workbook.Columns("D:R").EntireColumn.Delete
Workbook.Columns("F:H").EntireColumn.Delete
Workbook.Rows("1:2").Delete
Dim FLDR_NAME As String
FLDR_NAME = Application.ActiveWorkbook.Path & "_converted"
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
FLDR_NAME = Application.ActiveWorkbook.Path
FLDR_NAME = Replace(FLDR_NAME, "Converter", "Converter_Converted")
If Not fso.FolderExists(FLDR_NAME) Then
fso.CreateFolder (FLDR_NAME)
End If
Dim newFileName As String
newFileName = FLDR_NAME & "\" & Workbook.Name & "_converted.txt"
Workbook.SaveAs Filename:=newFileName
'Close + Save
Application.ActiveWorkbook.Close
End If
Next
End Sub
If you need to give your date that format then you should do this
new_date = Format(date_var, "dd.mm.yyyy hh:mm")
Where date_var would be the date you are getting with the code (but we cannot see).
Once you've gotten all your rows and columns deleted, you can format column A like this:
Workbook.Columns("A").NumberFormat = "dd.mm.yyyy hh:mm"
I have Multiple files in a folder.i wants to copy all Files data (i.e.all columns to new sheet) to one new sheet.
E.g. file 1 Contains 5 columns of data and file 2 contains 10 columns of data and so on. this data should copy on new sheet like first 5 columns are from file 1 and then on the same sheet from column 6, the file2 data should be copy and so on.
i tried but facing some problems like i am able to copy first file data successfully but when i am going to second file , second file data is overwriting on first file. i want second file data to the next column.
Below is my code
Public Sub CommandButton1_Click()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Dim mainwb As Workbook
Dim ws As Worksheet
Dim search_result As Range 'range search result
Dim blank_cell As Long
Dim wb As Workbook
Path = "C:\Test\"
Filename = Dir(Path & "*.xls")
'--------------------------------------------
'OPEN EXCEL FILES
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
Set wbk = Workbooks.Open(Path & Filename)
Set wbk = ActiveWorkbook
sheetname = ActiveSheet.Name
wbk.Sheets(sheetname).Activate
Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To Lastrow
wbk.Sheets(sheetname).UsedRange.Copy
Workbooks("aaa.xlsm").Activate
Set wb = ActiveWorkbook
sheetname1 = ActiveSheet.Name
Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
wb.Sheets(sheetname1).Range("A1").Select
wb.Sheets(sheetname1).Paste
Next i
ActiveCell.Offset(0, 1).Select
wbk.Close SaveChanges:=False
Filename = Dir
Loop
End Sub
plz help me......
Thanks in Advance
With the For i = 1 To Lastrow loop you are pasting the content several times and I was unable to correct it without significant change. As a result may I recommend using the below sample, I have added comments to describe what is happening.
Public Sub Sample()
Dim Fl As Object
Dim Fldr As Object
Dim FSO As Object
Dim LngColumn As Long
Dim WkBk_Dest As Excel.Workbook
Dim WkBk_Src As Excel.Workbook
Dim WkSht_Dest As Excel.Worksheet
Dim WkSht_Src As Excel.Worksheet
'Using FileSystemObject to get the folder of files
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.GetFolder("C:\Users\Gary\Desktop\New folder\")
'Setting a reference to the destination worksheet (i.e. where the
'data we are collecting is going to)
Set WkBk_Dest = ThisWorkbook
Set WkSht_Dest = WkBk_Dest.Worksheets("Sheet1")
'Look at each file in the folder
For Each Fl In Fldr.Files
'Is it a xls, xlsx, xlsm, etc...
If InStr(1, Right(Fl.Name, 5), ".xls") <> 0 Then
'Get the next free column in our destination
LngColumn = WkSht_Dest.Cells(1, WkSht_Dest.Columns.Count).End(xlToLeft).Column
If LngColumn > 1 Then LngColumn = LngColumn + 1
'Set a reference to the source (note in this case it is simply selected the first worksheet
Set WkBk_Src = Application.Workbooks.Open(Fl.Path)
Set WkSht_Src = WkBk_Src.Worksheets(1)
'Copy the data from source to destination
WkSht_Src.UsedRange.Copy WkSht_Dest.Cells(1, LngColumn)
Set WkSht_Src = Nothing
WkBk_Src.Close 0
Set WkBk_Src = Nothing
End If
Next
Set WkSht_Dest = Nothing
Set WkBk_Dest = Nothing
Set Fldr = Nothing
Set FSO = Nothing
End Sub
I am working on a excel newly jfor 1 weeks where i want to compare opened excel file current open file,
I made all possible but whenever I try to read the row, it only reading the value from the opened , I cant' able to access to read current workbook where i my macro was coded
Sub test1()
Dim iComp
Dim sheet As String
Dim wbTarget As Worksheet
Dim wbThis As Worksheet
Dim bsmWS As Worksheet
Dim c As Integer
Dim x As Integer
Dim strValue As String
Static value As Integer
Dim myPath As String
Dim folderPath As String
k = 3
Filename = Application.GetOpenFilename("Excel files (*.xls*),*.xl*", Title:="Open data") ' Choosing the Trigger Discription
'Set wbTarget = ActiveWorkbook.ActiveSheet
Set theRange = Range("A2:A4")
c = theRange.Rows.Count
strValue = vbNullString
For x = 1 To c
strValue = strValue & theRange.Cells(x, 1).value
Next x
'Set tabWS = Sheets("Tabelle1")
folderPath = Application.ActiveWorkbook.Path
myPath = Application.ActiveWorkbook.FullName
Set bsmWS = Sheets("Tabelle1")
Set wbkA = Workbooks.Open(Filename:="myPath")
Set varSheetA = wbkA.Worksheets("Balance sheet").Range(strRangeToCheck)
Its a 1000 line code , I just put only snippet.
I have myworksheet in the workbook where I am programed . I want to open another worksheet, take the value and compare it with my current worksheet . If string matches (ex range (A1:A2)) then msgbox yes
Have you tried using ThisWorkbook.Sheets("sheet name").Range("A2:A4") or ThisWorkbook.ActiveSheet.Range("A2:A4"). This will ensure the reference is to the workbook where the code is located.
More info on Application.ThisWorkbook
https://msdn.microsoft.com/en-us/library/office/ff193227.aspx.