I am trying to write a vbs to copy the latest modified files to another location. The script goes like this
Option Explicit
Dim oFSO, oFolder, oFile
Dim vSourcePaths ,vDestinationPaths
vSourcePaths = "C:\xampp\htdocs\lgmsuploads"
vDestinationPaths = "S:\LGMSUPLOADS"
Set oFSO = CreateObject("Scripting.FileSystemObject")
oFolder = oFSO.GetFolder(vSourcePaths)
For Each oFile In oFolder.Files
If oFile.DateLastModified < DateAdd("h", -24, Now) Then
oFSO.CopyFile vSourcePaths & "\" & oFile.Name, vDestinationPaths & "\" & oFile.Name
End If
Next
But this gives the following error
Please help...
You should use Set statement to assign an object reference to a variable as follows:
Set oFolder = oFSO.GetFolder(vSourcePaths)
However, your script will copy files with oFile.DateLastModified 24 hours ago and before.
Related
I'm pretty new to VBA but I am trying to learn a lot more. Right now I'm trying to code a macro to open the most recent file in my :Z drive that is a comma delimited file (.CSV). The below code doesn't work but I was wondering if anyone had any advice?
thanks for you help!
Sub NewestFile()
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
MyPath = "Z:\"
If Right(MyPath, 1) <> “ \ ” Then MyPath = MyPath & “ \ ”
MyFile = Dir(MyPath & “ * .csv”, 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
Here you go. Version 1 I have simply used a msgbox to display the last modified csv in the folder. Version 2 opens the file and uses filedialog due to OP difficulties with file path from fso.GetFolder.
Add reference to MS Scripting runtime (tool > references ) then
Sub GetLastModifiedCSV()
'Early binding code. Requires reference to MS Scripting Runtime
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
'Late binding code. To be used instead of two lines above if "user-defined type not defined" /No reference added. You would uncomment line below.
'Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
Dim myFolder As Object
Set myFolder = fso.GetFolder("C:\Users\User\Desktop\Test")
Dim currentFile As Object
Dim maxFileName As String
Dim maxDate As Date
For Each currentFile In myFolder.Files
If fso.GetExtensionName(currentFile) = "csv" Then
If currentFile.DateLastModified > maxDate Then
maxDate = currentFile.DateLastModified
maxFileName = currentFile.Name
End If
End If
Next currentFile
Msgbox maxFileName
End Sub
Additional references:
1) How to get the last modified file in a directory using VBA in Excel 2010
2) Using VBA FileSystemObject, specific file File extension
3) File system object explained
4) msoFileDialogFolderPicker
Version 2 Using FileDialog to get folderpath for GetFolder:
Option Explicit
Public Sub GetLastModifiedCSV()
Const folderPath As String = "C:\Users\User\Desktop\Test"
'Early binding code. Requires reference to MS Scripting Runtime
Dim fso As FileSystemObject
Set fso = New FileSystemObject
'Late binding code. To be used instead of two lines above if "user-defined type not defined" /No reference added. You would uncomment line below.
'Dim fso As Object: Set fso = CreateObject("FileSystemObject")
Dim myFolder As Object
Dim currentFile As Object
Dim maxFileName As String
Dim maxDate As Date
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
Set myFolder = fso.GetFolder(.SelectedItems(1)) ' & "\"
Else
Exit Sub
End If
End With
For Each currentFile In myFolder.Files
If fso.GetExtensionName(currentFile) = "csv" Then
If currentFile.DateLastModified > maxDate Then
maxDate = currentFile.DateLastModified
maxFileName = currentFile.Name
End If
End If
Next currentFile
'MsgBox maxFileName
Workbooks.Open fso.BuildPath(myFolder, maxFileName)
End Sub
There is an unzipping code I'd like to adjust 4 my needs.
Sub Unzip()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefinePath As String
' Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=False)
Fname = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl.zip"
If Fname = False Then
'Do nothing
Else
'Destination folder
DefinePath = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\" ' Change to your path / variable
If Right(DefinePath, 1) <> "\" Then
DefinePath = DefinePath & "\"
End If
FileNameFolder = DefinePath
' Delete all the files in the folder DefPath first if you want.
' On Error Resume Next
' Kill DefPath & "*.*"
' On Error GoTo 0
'Extract the files into the Destination folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
' MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
Somewhere here:
`Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere`
a dialog box appears asking me if I want to overwrite the file that have the same names - and Yes I do want to overwrite them, but without answering the dialog box - I would like to hardcode it into the code, please.
I've found this page https://msdn.microsoft.com/en-us/library/windows/desktop/bb787866(v=vs.85).aspx but I just don't know how to add this parameter #16 which is "Respond with "Yes to All" for any dialog box that is displayed."
Can U help me with that?
And the last thing:
can You explain oApp.Namespace(Fname).items line for me.
I've really tried to guess it myself, but I thing I'm to short 4 this.
the code that results in no questions or no prompting of any kind is as follows:
Option Explicit
Sub Bossa_Unzip()
Dim FSO As Object
Dim oApp As Object ' oApp is the object which has the methods you're using in your code to unzip the zip file:
'you need to create that object before you can use it.
Dim Fname As Variant
Dim FileNameFolder As Variant ' previously Dim FileNameFolder As Variant
Dim DefinePath As String
' Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=False)
Fname = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl.zip"
If Fname = False Then
'Do nothing
Else
'Destination folder
DefinePath = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\" ' Change to your path / variable
If Right(DefinePath, 1) <> "\" Then
DefinePath = DefinePath & "\"
End If
FileNameFolder = DefinePath
' Delete all the files in the folder DefPath first if you want.
' On Error Resume Next
' Kill DefPath & "*.*"
' On Error GoTo 0
'Extract the files into the Destination folder
Set oApp = CreateObject("Shell.Application") ' you need to create oApp object before you can use it.
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items, 16
'MsgBox "You'll find the files here: " & DefinePath
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
Of course this site helped me a lot - its CpyHere explanation site.
One thing I don't understand is why Fname and FileNumberFolder need to be declared as variant. In my opinion, they should be declared as String. Just look at this screenshot.
But when I declare them that way, the code gives me error.
Just look here, when the variables already have their values (first picture). The FileNameVariable and DefinePath variable have the exact same value, and it looks like a string 4 me. How is that necessary, that I need to declare another variable - FileNameVariable in that case (in 17th line) with the same value, but variant type.
please explain that to me, someone.
I am trying to rename a file from "X" to "XY" in the same folder. I have tried using File System Object and just the Name X as Y function, but neither is working. I do have the Microsoft Scripting Runtime reference installed. The code completes successfully but the file name does not change, Please advise.
Dim FSO As Object
Dim srcPath As String
Dim FromPath As String
Dim ToPath As String
Dim fldrName As String
srcPath = "C:\"
i = 1
Set FileSysObj_1 = New FileSystemObject
For Each Folder_Obj1 In FileSysObj_1.GetFolder(srcPath).SubFolders
i = i + 1
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
'If the file exists in the folder then rename it
If Dir(srcPath & Folder_Obj1.Name & "_Hotel.xlsx") Then
fldrName = Folder_Obj1.Name
FromPath = srcPath & fldrName & "_Hotel.xlsx"
ToPath = srcPath & "Hotel.xlsx"
'*** Neither of the following two lines work to rename the file
FSO.MoveFile FromPath, ToPath
Name FromPath As ToPath
Else
MsgBox "File doesn't exist."
End If
Next
Your question mentions that you're trying to rename a file in the same folder but, according to your code, you're actually moving it to the root of C:. You can use the following code as a replacement for what you have above. It will rename the file in its original folder.
Dim objFSO As New Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
For Each objFolder In objFSO.GetFolder("c:\").SubFolders
If objFSO.FileExists(objFolder.Path & "\_Hotel.xlsx") Then
' Rename...
objFSO.GetFile(objFolder.Path & "\_Hotel.xlsx").Name = "Hotel.xlsx"
End If
Next
Go to the tools menu in your VBA IDE and select references. Select "Microsoft Scripting Runtime".
Then declare
Dim FSO As FileSystemObject
Then the MoveFile should work.
Big Warning!
When using MoveFile for renaming a file it will only work with complete filenames without wildcards so
fso.MoveFile ( "somepath\myfile1.*" "somepath\myfile2" ) will error while
fso.MoveFile ( "somepath\myfile1.pdf" "somepath\myfile2.pdf" ) will work.
Wildcard in the first argument only works when really moving to a different location without changing the filename. Then the second argument should end with "\" Wonder why the documentation on MSDN is so cryptic.
I am looking to write a VB script to keep a folder tidy up. The rules are:
Check if any file was changed today
If at least one file was changed today move all the files last changed 2 days ago to another folder
This is what I have so far:
strFolder = "c:\testdelete"
objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
Set colFiles = objFolder.Files
For Each objFile In colFiles
If DateDiff("N",objFile.DateLastModified,Now()) > 4320 Then
objFSO.DeleteFile(objFile),True End if Next
This however is not working.
Iterate over the files in the folder while
building a list of the files modified at least 2 days ago, and
checking if a file was modified today.
Something like this should work:
Set fso = CreateObject("Scripting.FileSystemObject")
Set oldFiles = CreateObject("System.Collections.ArrayList")
today = Date
threshold = Date - 1
fileModifiedToday = False
For Each f In fso.GetFolder("C:\some\folder").Files
If f.DateLastModified >= today Then fileModifiedToday = True
If f.DateLastModified < threshold Then oldFiles.Add f
Next
If fileModifiedToday Then
For Each f In oldFiles
f.Move "C:\other\folder\"
Next
End If
So to compare the dates of the file and the current day you can utilize the DateValue() Function which returns only the date of the DateTime variable. Then you can utilize the MoveFile command which works like objFSO.MoveFile(FileObject, DestinationFolder)
Dim strFolder, Dest
On Error Resume Next 'Move to manual error handling.
strFolder = "c:\testdelete"
Dest = "C:\testmove"
Dim objFSO, objFolder, colFiles, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
Set colFiles = objFolder.Files
For Each objFile In colFiles
If DateValue(objFile.DateLastModified) = DateValue(Now) Then
objFSO.MoveFile(objFile, Dest)
if err.number <> 0 then msgbox "Destination does not exist"
err.clear
ElseIf DateDiff("N",objFile.DateLastModified,Now()) > 4320 Then
objFSO.DeleteFile(objFile,True)
if err.number <> 0 then msgbox "Unable to delete file"
err.clear
End if
Next
I have a Visual Basic script that converts excel files to text files. Let's say I have an excel file called example.xlsx; currently, the script saves it as example.xlsx.txt, which isn't what I want. I need it to save as: example.txt
Any ideas?
Option Explicit
Dim oFSO, myFolder
Dim xlTXT
myFolder="C:\..."
Set oFSO = CreateObject("Scripting.FileSystemObject")
xlTXT = 21 'Excel TXT format enum
Call ConvertAllExcelFiles(myFolder)
Set oFSO = Nothing
Call MsgBox ("Done!")
Sub ConvertAllExcelFiles(ByVal oFolder)
Dim targetF, oFileList, oFile
Dim oExcel, oWB, oWSH
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
Set targetF = oFSO.GetFolder(oFolder)
Set oFileList = targetF.Files
For Each oFile in oFileList
If (Right(oFile.Name, 4) = "xlsx") Then
Set oWB = oExcel.Workbooks.Open(oFile.Path)
For Each oWSH in oWB.Sheets
Call oWSH.SaveAs (oFile.Path & ".txt", xlTXT )
Exit For
Next
Set oWSH = Nothing
Call oWB.Close
Set oWB = Nothing
End If
Next
Call oExcel.Quit
Set oExcel = Nothing
End Sub
The FileSystemObject has a number of methods such as GetBaseName, GetFileName. So,
Call oWSH.SaveAs (myFolder & "\" & oFile.GetBaseName & ".txt", xlTXT)
(GetFileName would include the extension.)
But, as Harrison describes, you'll probably want to include the sheetname, or some number, as part of the filename.
You might consider using the worksheets' index as part of the file name, rather than having to invent numbers.
You are only saving the first sheet since you are exiting the foreach loop. To save all the sheets you can
Replace
For Each oWSH in oWB.Sheets
Call oWSH.SaveAs (oFile.Path & ".txt", xlTXT )
Exit For
Next
with
For Each oWSH in oWB.Sheets
Call oWSH.SaveAs (oWB.Name & "_" & oWSH.Name & ".txt", xlTXT )
Next
Note if you wanted to save just the first worksheet instead of using the Exit For after the first sheet you could use this.
Call oWB.Sheets(1).SaveAs (oWB.Name & ".txt", xlTXT )