VBA Site contains VBA code to create macros in WORD EXCEL ACCESS OUTLOOK

 

1) Scripting files from given directory.

 

2) Scripting last modification date of single file to act with date rule

 

3) Scripting last modification date of file in folder with specific extension

 

1) Scripting files from given directory.

 

The code* below allows to script files from given directory.

Works in Excel environment

Copy/Paste code below:

 

Sub ListFilesFolder()

Dim ob As Object, files As Object, file As Object

Dim FolderName As String

With Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = False

.Show

On Error Resume Next

FolderName = .SelectedItems(1)

Err.Clear

On Error GoTo 0

End With

Dim folder As Object, path$, r&: r = 2

path = FolderName

Cells(1, 1) = "FileName"

Cells(1, 2) = "File with path"

Cells(1, 3) = "size"

Cells(1, 4) = "type"

Cells(1, 5) = "created"

Cells(1, 6) = "last opened"

Cells(1, 7) = "date of modify"

Cells(1, 8) = "attribute"

Cells(1, 9) = "dos path"

Set ob = CreateObject("Scripting.FilesystemObject")

Set folder = ob.GetFolder(path)

Set files = ob.GetFolder(folder).files

With Application

.ScreenUpdating = False

.EnableEvents = False

For Each file In files

'example of excluding:

'If Mid(LCase(file), InStrRev(file, ".") + 1, 3) = "xls" Then 'excluding by extension

'If CDate(file.DateCreated) > Format(Now - 7, "YYYY-MM-DD") Then 'excluding by date

Cells(r, 1) = file.Name

Cells(r, 2) = folder & "" & file.Name

Cells(r, 3) = file.Size

Cells(r, 4) = file.Type

Cells(r, 5) = file.DateCreated

Cells(r, 6) = file.DateLastAccessed

Cells(r, 7) = file.DateLastModified

Cells(r, 8) = file.Attributes

Cells(r, 9) = file.ShortPath & file.ShortName

r = r + 1

'End If

'End If

Next file

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

 

'*Code from MVP OShon from VBATools.pl extended by browser funcion

 

2) Scripting last modification date of single file to act with date rule

 

Sub GetDateLastModified()

Dim aFSO As Object

Dim aFile As String

aFile = "C:\MyFolder\YourFile.xlsx"

Set aFSO = CreateObject("Scripting.FileSystemObject")

If CDate(Format(aFSO.GetFile(aFile).DateLastModified, "Short Date")) = Date Then

MsgBox "Yes"

Set aFSO = Nothing

Else

End If

End Sub

 

3) Scripting last modification date of files in folder with specific extension

 

Dim fso, path, file, recentDate, recentFile

Set fso = CreateObject("Scripting.FileSystemObject")

Set recentFile = Nothing

For Each file In fso.GetFolder("C:\YourFolder").Files

If LCase(fso.GetExtensionName(file.Name)) = "txt" Then

If (recentFile Is Nothing) Then

Set recentFile = file

ElseIf (file.DateLastModified > recentFile.DateLastModified) Then

Set recentFile = file

End If

End If

Next

 

2) Scripting folders

 

Sub scriptFolders()

Dim objFSO, objSubFolder

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder("W:\")

For Each objSubFolder In objFolder.subfolders

Debug.Print objSubFolder.Name

Debug.Print objSubFolder.path

Next objSubFolder

End Sub



Dodaj komentarz






Dodaj

© 2013-2024 PRV.pl
Strona została stworzona kreatorem stron w serwisie PRV.pl