none
Excel Macro stops working all of a sudden 2 of 2 RRS feed

  • Question

  • Hello there,

    I have developed a utility to create task in Outlook from Excel. But all of a sudden it stops working as desired. 

    What the macro does is 

    - Brings all tasks to be inserted from another tab (thats the reason why first step in my macro is to fill the formula to 20 rows) and then delete the blank ones. (blank one are identified as "Done" in column K)

    -Then it asks for Email Id from the user

    - and create task in outlook for each row like this.

    However it stops working the moment it ask the email id.

    Please help here. I am a learner coder so its my own way to find small pieces of code and combine it to solve my requirements so please feel free to suggest any modification.

    Sub Test()
    
    Application.EnableEvents = False
        
       'Fill The three formula to 50 rows
        
        Range("B2:B" & 20).FillDown
        Range("K2:K" & 20).FillDown
        
        'Delete all extra rows
        Application.ScreenUpdating = False
        With Sheets("Import Tasks").Range("k1", Range("k" & Rows.Count).End(xlUp))
            .AutoFilter field:=1, Criteria1:=Array("Done"), Operator:=xlFilterValues
            .Offset(1).EntireRow.Delete
            .AutoFilter
        End With
        Application.ScreenUpdating = True
        
         'Import Tasks to Outlook
        Dim MyOutlook As Outlook.Application
        Dim objTask As TaskItem
        Dim NS As Namespace
        Dim NoA As Long, i As Long
        Dim myValue As Variant
        Dim Mileage As String
        Dim Billinginformation As String
        Dim Companies As String
        
        NoA = Cells(65536, 1).End(xlUp).Row
        myValue = InputBox("Input your Email ID")
        
        Set MyOutlook = New Outlook.Application
        Set NS = MyOutlook.GetNamespace("MAPI")
        Set myFolder = NS.Folders(myValue).Folders("Tasks")
        
        Set myItems = myFolder.Items
        
        
        'Add new items to the "Tasks" folder
        For i = 2 To NoA
            Set objTask = myItems.Add(olTaskItem)
                With objTask
                    .Subject = Cells(i, 1)
                    .Body = Cells(i, 2)
                    .Categories = Cells(i, 3)
                    .Mileage = Cells(i, 4)
                    .Billinginformation = Cells(i, 5)
                    .Companies = Cells(i, 6)
                    'For Status
                    If Cells(i, 8).Value = "Completed" Then
            .Status = olTaskComplete
    
            ElseIf Cells(i, 8).Value = "In Progress" Then
            .Status = olTaskInProgress
    
            ElseIf Cells(i, 8).Value = "Deferred" Then
            .Status = olTaskDeferred
    
            ElseIf Cells(i, 8).Value = "Not Started" Then
            .Status = olTaskNotStarted
    
            ElseIf Cells(i, 8).Value = "Waiting on someone else" Then
            .Status = olTaskWaiting
            End If
                    .ActualWork = Cells(i, 7)
                    .Save
                End With
            Set objContact = Nothing
        Next
        
        Set NS = Nothing
        Set myFolder = Nothing
        Set myItems = Nothing
        Set MyOutlook = Nothing
        
        Macro1
        
        Application.EnableEvents = True
        
    End Sub


    Dhaval Paun

    Wednesday, May 3, 2017 1:24 PM

All replies

  • Hello there,

    I have developed a utility to move all completed tasks from one tab to another AND delete all the moved once from the existing tab. But all of a sudden the deletion part stops working.

    Please help here. I am a learner coder so its my own way to find small pieces of code and combine it to solve my requirements so please feel free to suggest any modification.

    Sub CopyCompleted()
    Application.EnableEvents = False
        Dim wsSource As Worksheet
        Dim wsDestin As Worksheet
        Dim lngDestinRow As Long
        Dim rngSource As Range
        Dim rngCel As Range
        
        Set wsSource = Sheets("Dashboard")
        Set wsDestin = Sheets("Completed")
        
        With wsSource
            'Following line assumes column headers in Source worksheet so starts at row2
            Set rngSource = .Range(.Cells(2, "G"), .Cells(.Rows.Count, "G").End(xlUp))
        End With
        Application.ScreenUpdating = False
        
        For Each rngCel In rngSource
            If rngCel.Value = "Completed" Then
                With wsDestin
                    'Following line assumes column headers in Destination worksheet
                    lngDestinRow = .Cells(.Rows.Count, "G").End(xlUp).Offset(1, 0).Row
                    rngCel.EntireRow.Copy
                    .Cells(lngDestinRow, "A").PasteSpecial Paste:=xlPasteValues
                    .Cells(lngDestinRow, "A").PasteSpecial Paste:=xlPasteFormulas
                    .Cells(lngDestinRow, "A").PasteSpecial Paste:=xlPasteValidation
                End With
            End If
        Next rngCel
        
    
     
    Const TEST_COLUMN As String = "G"       '<<<< change to suit
    Dim Lastrow As Long
    Dim i As Long
    
        
        With ActiveSheet
        
            Lastrow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
            For i = Lastrow To 1 Step -1
            
                If Cells(i, TEST_COLUMN).Value2 Like "Completed" Then
                
                    .Rows(i).Delete
                End If
            Next i
        End With
         Worksheets("Completed").Activate
        
        Sheets("Completed").CommandButton1 = True
    Sheets("Completed").CommandButton1 = vbClick
        
       Worksheets("Dashboard").Activate
        
        
        Application.ScreenUpdating = True
    
    Range("A5").Select
    Application.EnableEvents = True
    
    End Sub



    Dhaval Paun

    Wednesday, May 3, 2017 1:17 PM
  • Hi Dhaval,

    I notice the issue is related to the Macro codes. To better resolve your issue, I would move the thread to Excel for developers forum for more suggestion:

    https://social.msdn.microsoft.com/Forums/office/en-US/home?forum=exceldev

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.


    Regards,

    Winnie Liang


    Please remember to mark the replies as answers if they help.
    If you have feedback for TechNet Subscriber Support, contact tnmff@microsoft.com.

    Thursday, May 4, 2017 4:06 AM
  • Hello,

    I suggest you close your previous thread if the issue has been resolve.

    https://social.msdn.microsoft.com/Forums/en-US/0c686c57-8ceb-47ba-a3f4-d5bcbc2f7673/macro-in-outlook-simple?forum=outlookdev

    >>However it stops working the moment it ask the email id. & But all of a sudden the deletion part stops working.

    Would you get any runtime error? What is the error and in which line would you get the error? Could you reproduce it in other computer?

    What is your Office version? Do you have any Office update recently?

    Do you input an valid Email ID? I would suggest you check if "myValue" is valid before getting "myFolder" object.


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.


    Thursday, May 4, 2017 7:19 AM
    Moderator