https://github.com/ermjs/excel-vba-folder-files

Excel-VBA-folder-files
https://github.com/ermjs/excel-vba-folder-files

Last synced: 2 months ago
JSON representation

Excel-VBA-folder-files

• Host: GitHub
• URL: https://github.com/ermjs/excel-vba-folder-files
• Owner: ermjs
• Created: 2023-08-28T09:02:53.000Z (almost 2 years ago)
• Default Branch: main
• Last Pushed: 2023-08-28T09:03:28.000Z (almost 2 years ago)
• Last Synced: 2025-03-25T14:14:22.918Z (3 months ago)
• Size: 1.95 KB
• Stars: 0
• Watchers: 1
• Forks: 0
• Open Issues: 0
• Metadata Files:
  • Readme: README.md

Awesome Lists containing this project

README

        
# Excel-VBA-folder-files

Excel-VBA-folder-files

```vba

Sub moveFiles()

Dim oFSO As Object 'FileSystemObject

Dim oFolder As Object 'Scan target folder

Dim oFile As Object 'Found target file

Dim fileObj As Object 'File object for mod date

Dim fileModDate As String

Dim fileModDateEpoch As Double 'Fake windows epoch

Dim fileDate As Integer 'Strip after decimal and preserve date as integer

Dim shift As String

Dim osPathSeperator As String 'Operation system path seperator

Dim mainFolder As String

Dim newFolder As String

Dim mainFolderPath As String

Dim newFolderPath As String

osPathSeperator = "\" 'Define for windows

mainFolder = "Fotolar"

newFolder = "Yeni"

mainFolderPath = ActiveWorkbook.Path & osPathSeperator & mainFolder

newFolderPath = ActiveWorkbook.Path & osPathSeperator & newFolder

'Define active path

'Debug.Print "Main Folder Path --> " & mainFolderPath

'Debug.Print "New Folder Path --> " & newFolderPath

'Create FileSystemObject

Set oFSO = CreateObject("Scripting.FileSystemObject")

'Create working folders

If Not oFSO.FolderExists(newFolderPath) Then

  oFSO.CreateFolder newFolderPath

End If

If Not oFSO.FolderExists(mainFolderPath) Then

  oFSO.CreateFolder mainFolderPath

End If

'Scan dir

Set oFolder = oFSO.GetFolder(newFolderPath)

'Loop each file

For Each oFile In oFolder.Files

    

    Set fileObj = oFSO.GetFile(oFile) 'Get file object

    'fileModDate = fileObj.DateLastModified 'Read mod timestamp as string

    fileModDateEpoch = CDbl(fileObj.DateLastModified) 'Convert to epoch before converting string

    

    'Find shift

    If fileModDateEpoch >= Int(fileModDateEpoch) + (1 / 24 * 0) And fileModDateEpoch < Int(fileModDateEpoch) + (1 / 24 * 8) Then

      shift = Format(fileModDateEpoch, "yyyy-mm-dd") & " 00-08"

    ElseIf fileModDateEpoch >= Int(fileModDateEpoch) + (1 / 24 * 8) And fileModDateEpoch < Int(fileModDateEpoch) + (1 / 24 * 16) Then

      shift = Format(fileModDateEpoch, "yyyy-mm-dd") & " 08-16"

    ElseIf fileModDateEpoch >= Int(fileModDateEpoch) + (1 / 24 * 16) And fileModDateEpoch < Int(fileModDateEpoch) + (1 / 24 * 24) Then

      shift = Format(fileModDateEpoch, "yyyy-mm-dd") & " 16-24"

    End If

    

    ' Show shift

    'Debug.Print mainFolderPath & osPathSeperator & shift

    

    'Check if folder exist

    If Not oFSO.FolderExists(mainFolderPath & osPathSeperator & shift) Then

      'Create folder

      oFSO.CreateFolder mainFolderPath & osPathSeperator & shift

    End If

    

    

    'Move file to related folder

    'MoveFile doesnt have overwrite option

    'oFSO.MoveFile Source:=oFile, Destination:=mainFolderPath & osPathSeperator & shift & osPathSeperator & oFile.Name

    

    'Copy paste alternative

    oFSO.CopyFile oFile, mainFolderPath & osPathSeperator & shift & osPathSeperator & oFile.Name, True

    oFSO.DeleteFile oFile

        

    'Debug.Print oFile

    'Debug.Print oFile.Name

Next oFile

'Clear memory

Set oFSO = Nothing

Set oFolder = Nothing

End Sub

```