Im completely new to VBA. I'm trying to write macro what open latest file from folder and copy and past data from specific sheet. I need to copy data from file opened by VBA (latest file from folder) and copy data from one sheet to my current file (Expiry date sheet).
I don't know how to declare open file as workbook from where I want to copy data. Any advice?
Private Sub CommandButton1_Click()
'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Set Y = Workbooks("TEST")
MyPath = "C:\Users\e9\Desktop\Automatyczne sprawdzanie expiry date\New folder\"
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyFile = Dir(MyPath & "*.xls", vbNormal)
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
Do While Len(MyFile) > 0
LMD = FileDateTime(MyPath & MyFile)
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
MyFile = Dir
Loop
Workbooks.Open MyPath & LatestFile
End Sub
Below is code sample taken from various references ..
Find Last modified file
You have to add reference for the FileSystemObject .. FileSystemObject how to add reference
Tested by adding a ActiveX button to worksheet on destination file (Book2.xlsm). Change the path and also "Book2.xlsm" to your path and filename.
Dim sFldr As String
Dim fso As Scripting.FileSystemObject
Dim fsoFile As Scripting.File
Dim fsoFldr As Scripting.Folder
Dim dtNew As Date, sNew As String
Dim sFileName As String
Set fso = New Scripting.FileSystemObject
sFldr = "C:\Temp\stackoverflow\excel\"
Set fsoFldr = fso.GetFolder(sFldr)
For Each fsoFile In fsoFldr.Files
If fsoFile.DateLastModified > dtNew Then
sNew = fsoFile.Path
sFileName = fsoFile.Name
dtNew = fsoFile.DateLastModified
End If
Next fsoFile
Workbooks.Open Filename:=sNew
Sheets("Sheet1").Copy Before:=Workbooks("Book2.xlsm").Sheets(1)
Windows(sFileName).Activate
ActiveWindow.Close
Once the latest file is opened,
Sheets("x").Activate
ActiveSheet.Range("x:y").select
selection.copy
workbooks("x").activate
sheets("X").activate
activesheet.range("x").select
selection.paste
Replace the xs and ys with desired names/ranges.
afterward continue your loop
Related
little to no experience but learning slowly.
The first code below was adequate for my means. Goto directory and open closed file named "HL", copy only sheet to open workbook named "01" before specific sheet then rename sheet. Then close file named "HL"
Sub AAB()
Application.ScreenUpdating = False
Set Source_workbook = Workbooks.Open("S:\VBA\MASTER DEV\2022-10-08\HL\HL.xlsx")
Source_workbook.Sheets("Data_Landscape_blackwhite").Copy Before:=ThisWorkbook.Sheets(1)
Worksheets("Data_Landscape_blackwhite").Name = "HL Start 31" 'Set new name
Source_workbook.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
I then tried some different code below, wanting to allow the latest dynamic named .xlsx file in the directory to be opened and to obtain the same results from code 1
'Force the explicit delcaration of variables
Option Explicit
Sub OpenLatestFile()
'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
'Specify the path to the folder
MyPath = "S:\VBA\MASTER DEV\2022-10-08\HL\"
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.xlsm", vbNormal)
'If no files were found, exit the sub
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each Excel file in the folder
Do While Len(MyFile) > 0
'Assign the date/time of the current file to a variable
LMD = FileDateTime(MyPath & MyFile)
'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 = MyFile
LatestDate = LMD
End If
'Get the next Excel file from the folder
MyFile = Dir
Loop
'Open the latest file
Workbooks.Open MyPath & LatestFile
End Sub
I have tried all kinds of permitations and cannot fathom how to resolve. Was hoping that someone could assist in some direction towards a resolution.
Appreciate any help on offer.
Cheers
Have a good day
I am new to VBA, I have pieced together the following code to convert all .xls files to .xlsx in a folder and delete old .xls files.
I ran it and it worked...now it does not. Now I get a Runtime error 53 'File not found', the code hangs at the Kill command after successfully saving the file. Any ideas?
Sub ConvertToXlsx()
Dim strPath As String
Dim strFile As String
Dim wbk As Workbook
' Path must end in trailing backslash
strPath = "C:\Work Docs\Command and Control\Test\"
strFile = Dir(strPath & "*.xls")
Do While strFile <> ""
If Right(strFile, 3) = "xls" Then
Set wbk = Workbooks.Open(Filename:=strPath & strFile)
ActiveSheet.Name = "NewName"
wbk.SaveAs Filename:=strPath & strFile & "x", _
FileFormat:=xlOpenXMLWorkbook
wbk.Close SaveChanges:=False
If Right(strFile, 3) = "xls" Then
Kill strFile
End If
End If
strFile = Dir
Loop
End Sub
I cant test this currently so sorry if it doesn't work.
I always prefer to use the FileSystemObject to iterate files in folders.
Its creates the files as objects and opens you up to many useful attributes and methods etc.
First you need to
set reference to microsoft scripting runtime
as per this link https://www.automateexcel.com/vba/getfolder-getfile/
Then ...
Sub delete_xls_replace_with_xlsx()
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim fldr As Folder
Dim fl As File
Dim wbk As Workbook
'set the folder
Set fldr = fso.GetFolder("C:\Users\username\documents\folder")
'iterate the files in the folder
For Each fl In fldr.Files
'check if xls
If Right(fl.Path, 3) = "xls" Then
'open wb
Set wbk = Workbooks.Open(fl.Path)
' save with new ext
wbk.SaveAs Filename:=Replace(fl.Path, "xls", "xlsx"), FileFormat:=51
wbk.Close SaveChanges:=False
'here it will delete the file
fso.DeleteFile (fl.Path)
End If
Next fl
End Sub
I want to write a script which opens the two last modified files in a sharepoint folder called "Test". These are Excel CSV files, so they should open in Excel. This is what I came up with, it seems to work for a local folder, but not for Sharepoint.
Sub test()
Dim SummaryWB As Workbook
Dim FileSys, objFile, myFolder, c As Object
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim strFilename, strFilename2
FolderName = ("https://sharepoint.com/sites/Team/Shared%20Documents/Test")
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set myFolder = FileSys.GetFolder(FolderName)
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If InStr(1, objFile.Name, ".csv") > 0 Then
If objFile.DateLastModified > dteFile Then
dteFile = objFile.DateLastModified
strFilename2 = strFilename
strFilename = objFile.Name
End If
End If
Next objFile
Set wb1 = Workbooks.Open(FolderName & Application.PathSeparator & strFilename)
Set wb2 = Workbooks.Open(FolderName & Application.PathSeparator & strFilename2)
End Sub
I have hundreds of XLS files I need converted to XLSX.
I found this old thread with the same title and the code provided converts the files to XLSX but corrupts them.
My understanding is, this code renames the file with the proper xlsx extension but does not change the file format.
I am under the impression I need to make the file format FileFormat:=51
I tried adding ", FileFormat:=51" to the name but that did not seem to work.
Any suggestions on how I can change the FileFormat to 51?
Thank you
Love you all
Sub ChangeFileFormat_V1()
Dim strCurrentFileExt As String
Dim strNewFileExt As String
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As File 'Object
Dim xlFile As Workbook
Dim strNewName As String
Dim strFolderPath As String
strCurrentFileExt = ".xls"
strNewFileExt = ".xlsx"
strFolderPath = "C:\Users\Scorpio\Desktop\New folder"
If Right(strFolderPath, 1) <> "\" Then
strFolderPath = strFolderPath & "\"
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getfolder(strFolderPath)
For Each objFile In objFolder.Files
strNewName = objFile.Name
If Right(strNewName, Len(strCurrentFileExt)) = strCurrentFileExt Then
strNewName = Replace(strNewName, strCurrentFileExt, strNewFileExt)
Application.DisplayAlerts = False
objFile.Name = strNewName
Application.DisplayAlerts = True
End If
Next objFile
``ClearMemory:
strCurrentFileExt = vbNullString
strNewFileExt = vbNullString
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Set xlFile = Nothing
strNewName = vbNullString
strFolderPath = vbNullString
End Sub
Like I mentioned in the comment, you cannot just change the extention and expect it to work. You are supposed to open the file and do a .SaveAs NewFilename,Fileformat for each one of them.
Is this what you are trying? (Untested)
Sub Sample()
Dim strFolderPath As String
Dim StrFile As String
Dim NewFilename As String
Dim wb As Workbook
'~~> Set your folder here
strFolderPath = "C:\Users\Scorpio\Desktop\New folder\"
'~~> Loop through all the xls files in the folder
StrFile = Dir(strFolderPath & "*.xls")
Do While Len(StrFile) > 0
'~~> Get file name without extension
NewFilename = Left(StrFile, (InStrRev(StrFile, ".", -1, vbTextCompare) - 1))
Set wb = Workbooks.Open(strFolderPath & StrFile)
wb.SaveAs NewFilename & ".xlsx", FileFormat:=xlOpenXMLWorkbook
DoEvents
wb.Close (False)
StrFile = Dir
Loop
End Sub
I've found the below code which works nearly as id like to.
However when i go to copy the pivot data worksheet and specifically paste it in the tab called "Data" in the Resource Costing...xls i cant seem to make it work.
Also once its copied how do i close the excel file that it was copied from? Any help, advice is much appreciated.
Sub OpenLatestResourceForecastFile()
'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Dim MyData As Workbook
Set CopiedData = Workbooks("Resource Costing E3.xlsm").Sheets(4)
Set wb = ActiveWorkbook
'Specify the path to the folder
MyPath = "C\doc etc"
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.xls", vbNormal)
'If no files were found, exit the sub
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each Excel file in the folder
Do While Len(MyFile) > 0
'Assign the date/time of the current file to a variable
LMD = FileDateTime(MyPath & MyFile)
'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 = MyFile
LatestDate = LMD
End If
'Get the next Excel file from the folder
MyFile = Dir
Loop
'Open the latest file and copy Pivot Data Tab
Workbooks.Open MyPath & LatestFile
Worksheets("Pivot Data").Copy After:=CopiedData
End Sub
In the Code Below i an Example how you can close the Workbook. Use a variable for the Workbook you are going to Open. After that you can close it without Saving it.
Dim wbLatestFile As Workbook
'Open the latest file and copy Pivot Data Tab
Set wbLatestFile = Workbooks.Open MyPath & LatestFile
wbLatestFile .Worksheets("Pivot Data").Copy After:=CopiedData
wbLatestFile.Close SaveChanges:=False