none
Create To-Do List from a Directory of Files RRS feed

  • Question

  • I'm wondering if it is possible to have VBA code do open a directory, and for each file in that directory, create a task / to-do list, and also attach the file to the task / to-do list?

    I'm attempting to create a Monthly Close To Do List so that I can track when the status of the files for the current month that I'm working on closing.

    Thoughts / Suggestions?

    JMData Consultant

    Friday, October 18, 2013 3:59 PM

Answers

  • Solution Found:

    I took code from my excel file that lists the files in a directory, and combined it with a loop that for each file it finds in the directory to create a task item in a sub-task folder.

    As I'm still learning VBA Code, I'd appreciate feedback / improvement suggestions on the code to see if there are simpler ways of coding this solution.

    JMData Consultant

        
    Sub MakeNewMonthCloseTaskSchedule()
    ' LISTS FILES FROM VFF INVENTORY CLOSE ACCORDING TO THE FILE NAME
        Dim objFSO As Object
        Dim objFolder As Object
        Dim objFile As Object
        
        Dim Enddate As Date
        Dim ROW As Integer
        Dim MONTHENDDATE As Date
        Dim PREVMONTH As Date
                
        Dim Today As Date
        Today = Date
        PREVMONTH = WorksheetFunction.EoMonth((Now()), -1)
        'MsgBox Format(Today, "MM/DD/YYYY")
        Dim ParentDirectory As String ' 1st level directory
        Dim ChildDirectory As String ' 2nd level directory
        Dim MonthlyDirectory As String ' 3rd Level Directory
      
        
        ParentDirectory = "W:\MONTHLY CLOSE WORKPAPERS"
        ChildDirectory = ParentDirectory & "\FY" & Format(PREVMONTH, "YYYY") & " Financial Close Workbook"
        MonthlyDirectory = ChildDirectory & "\FY" & Format(PREVMONTH, "yymm") & "_" & Format(PREVMONTH, "mmm")
        PREVIOUSMONTHDIRECTORY = MonthlyDirectory
        MONTHENDDATE = WorksheetFunction.EoMonth((Date - 1), 0)
         
        Set objFSO = CreateObject("Scripting.FileSystemObject")
            
         'Get the folder object associated with the directory
        Set objFolder = objFSO.GetFolder(PREVIOUSMONTHDIRECTORY)
        Enddate = Date
             
         'Loop through the Files collection
        For Each objFile In objFolder.files
            Dim objApp As Outlook.Application
            Dim defaultTasksFolder As Outlook.MAPIFolder
            Dim subFolder As Outlook.MAPIFolder
            Dim objNS As Outlook.NameSpace
            Dim objItm As TaskItem
            'Dim Today As Date
            'Today = Now()
            Set objApp = CreateObject("Outlook.Application")
    
            Set objNS = objApp.GetNamespace("MAPI")
            Set defaultTasksFolder = objNS.GetDefaultFolder(olFolderTasks)
            Set subFolder = defaultTasksFolder.Folders("Close Tasks")
    
            Set objItm = subFolder.Items.Add(olTaskItem)
            With objItm
          
                .Subject = objFile.Name
                .Attachments.Add PREVIOUSMONTHDIRECTORY & "\" & objFile.Name
                '.ReminderSet = True
                '.ReminderTime = Format(DateSerial(year(Today), month(Today), day(Today) + 1), "short date") & " " & Format("6:15:00 AM", "short time")
                .Save
    
           End With
        Next
        
    
    
    End Sub
    
    

    Monday, October 21, 2013 6:11 PM

All replies

  • Hi,

    Here is a sample for your reference:

    Sub AddNewTask()
        Dim objTask As Outlook.TaskItem
        Dim objMail As Outlook.MailItem
        Dim MyObj As Object, MySource As Object, file As Variant
        Dim filepath As String
        filepath = "E:\Access\"
        file = Dir(filepath)
        While (file <> "")
            Set objTask = Application.CreateItem(olTaskItem)
            With objTask
                .Subject = file
                .StartDate = DateTime.Now
                .Body = ""
                .Attachments.Add filepath & file
                .Status = olTaskInProgress
                .Save
            End With
            Set objTask = Nothing
            Set objMail = Nothing
            file = Dir
        Wend
    End Sub

    I have two files in E:\Access\, after I run the code above, I can see these two new tasks:

    And the file is attaching to the task/to-do list:

    Hope this can give you help.


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, October 21, 2013 10:25 AM
    Moderator
  • George Hua,

    Thank you very much... That is exactly what I was looking to accomplish.  I appreciate the help and quick response.

    JMData Consultant

    Monday, October 21, 2013 1:47 PM
  • George,

    I'm attempting to put in your code, and it's not adding tasks to my tasks listing. Ultimately I want the path to be a variable so that the code can automatically find the previous month's directory to pull the more current files.

    To start though, I'm hard coding the path, and the tasks aren't being added.  Is there a reference library that has to be enabled in order for your code to work?

    It appears that you modified your code from getting items from an e-mail to going to a directory path. I.E. Outlook.MailItem, etc.

    You declare the following:

    Dim MyObj As Object, MySource As Object, file As Variant

    But I don't see anywhere in the code above where these are being assigned to anything.

    I'm using Outlook 2010 and running on Windows 7 machine.

    Please let me know if you need any other specs.

    Thanks.

    JMData Consultant


    Monday, October 21, 2013 5:15 PM
  • Solution Found:

    I took code from my excel file that lists the files in a directory, and combined it with a loop that for each file it finds in the directory to create a task item in a sub-task folder.

    As I'm still learning VBA Code, I'd appreciate feedback / improvement suggestions on the code to see if there are simpler ways of coding this solution.

    JMData Consultant

        
    Sub MakeNewMonthCloseTaskSchedule()
    ' LISTS FILES FROM VFF INVENTORY CLOSE ACCORDING TO THE FILE NAME
        Dim objFSO As Object
        Dim objFolder As Object
        Dim objFile As Object
        
        Dim Enddate As Date
        Dim ROW As Integer
        Dim MONTHENDDATE As Date
        Dim PREVMONTH As Date
                
        Dim Today As Date
        Today = Date
        PREVMONTH = WorksheetFunction.EoMonth((Now()), -1)
        'MsgBox Format(Today, "MM/DD/YYYY")
        Dim ParentDirectory As String ' 1st level directory
        Dim ChildDirectory As String ' 2nd level directory
        Dim MonthlyDirectory As String ' 3rd Level Directory
      
        
        ParentDirectory = "W:\MONTHLY CLOSE WORKPAPERS"
        ChildDirectory = ParentDirectory & "\FY" & Format(PREVMONTH, "YYYY") & " Financial Close Workbook"
        MonthlyDirectory = ChildDirectory & "\FY" & Format(PREVMONTH, "yymm") & "_" & Format(PREVMONTH, "mmm")
        PREVIOUSMONTHDIRECTORY = MonthlyDirectory
        MONTHENDDATE = WorksheetFunction.EoMonth((Date - 1), 0)
         
        Set objFSO = CreateObject("Scripting.FileSystemObject")
            
         'Get the folder object associated with the directory
        Set objFolder = objFSO.GetFolder(PREVIOUSMONTHDIRECTORY)
        Enddate = Date
             
         'Loop through the Files collection
        For Each objFile In objFolder.files
            Dim objApp As Outlook.Application
            Dim defaultTasksFolder As Outlook.MAPIFolder
            Dim subFolder As Outlook.MAPIFolder
            Dim objNS As Outlook.NameSpace
            Dim objItm As TaskItem
            'Dim Today As Date
            'Today = Now()
            Set objApp = CreateObject("Outlook.Application")
    
            Set objNS = objApp.GetNamespace("MAPI")
            Set defaultTasksFolder = objNS.GetDefaultFolder(olFolderTasks)
            Set subFolder = defaultTasksFolder.Folders("Close Tasks")
    
            Set objItm = subFolder.Items.Add(olTaskItem)
            With objItm
          
                .Subject = objFile.Name
                .Attachments.Add PREVIOUSMONTHDIRECTORY & "\" & objFile.Name
                '.ReminderSet = True
                '.ReminderTime = Format(DateSerial(year(Today), month(Today), day(Today) + 1), "short date") & " " & Format("6:15:00 AM", "short time")
                .Save
    
           End With
        Next
        
    
    
    End Sub
    
    

    Monday, October 21, 2013 6:11 PM