Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88854

Macro stops looping if I call a macro to send an email

$
0
0

I have a workbook named Run All Weekly Reports.xlsm where I list reports that I update each Monday. The workbook/report names to be updated are in column A, the workbook paths in column B and the macro names in column C.

The macro (that I found somewhere online) works perfectly, looping through all of the files and refreshing the data, but I have recently added some files that refresh the data and then call another macro (within the other workbook) to email the workbooks to my colleagues. Once it sends the email, this macro stops and will not continue looping through the rest of the other workbooks. I think it has something to do with Setting the object back to Excel. I have Google searched and tried Set xlApp = CreateObject("Excel.Application"), but it will not continue the loop.

Any help would be greatly appreciated. Here is my macro:

Sub Run()
    'PURPOSE: To loop through all Excel files listed in Worksheet and run macro listed in column C

    Dim wb As Workbook
    Dim myPath As String

    Dim fn As String
    Dim MacroName As String
    Dim x As Integer

    NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
    For x = 1 To NumRows

        Workbooks("Run All Weekly Reports.xlsm").Sheets("List").Activate
        ActiveCell.Offset(1, 0).Select

        fn = ActiveCell.Offset(0, 0).Value
        myPath = ActiveCell.Offset(0, 1).Value
        MacroName = ActiveCell.Offset(0, 2).Value
        ActiveCell.Offset(0, 3) = "Done"

        If myPath = "" Then GoTo ResetSettings
        Set wb = Workbooks.Open(Filename:=myPath & fn)
        Application.Run "'"& fn & "'!"& MacroName

        wb.Close SaveChanges:=True
        Workbooks("RUN ALL WEEKLY REPORTS.xlsm").Save

        'Ensure Workbook has closed before moving on to next line of code
        DoEvents

ResetSettings:
        'Reset Macro Optimization Settings
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    Next
    MsgBox ("Finished")
End Sub

My macro experience is limited to a bit of trial and error, so please excuse my crude descriptions.

The macro in my original message is one that I copied from somewhere online and just modified it a little to suit.

I copied it into my macro enabled workbook and so to launch it, I have to select the macro called 'Run' from my macro list and 'Run' it.

I think that means that it is a public sub?
I have a list of workbooks in a file eg. Backorder Reports that it opens and Refreshes the data from an ODBC query, then calls the email to send to my colleague, but after the Sub SEND_Mail_Outlook_With_Signature_Html(), the loop macro just stops.

If I don't call the SEND macro, it loops through to the next file listed in my workbook without a problem.
I hope that I am making sense.

Below is and example of the macro's that are in each of my sheets that it should open and execute.

Sub Refresh()

    ' Refreshes the data and the dates in the pivot tables

    ActiveWorkbook.RefreshAll
    Application.CalculateUntilAsyncQueriesDone
    ActiveWorkbook.Save
    Call SEND_Mail_Outlook_With_Signature_Html
    ActiveWorkbook.Close

End Sub

Sub SEND_Mail_Outlook_With_Signature_Html()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim StrBody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    StrBody = "Today's report attached."

    On Error Resume Next

    With OutMail
        .Display
        .To = "mycolleague@live.com.au"
        .CC =
        .BCC =
        .Subject = "Backorder Report"
        .HTMLBody = StrBody & "<br>"& .HTMLBody
        .Attachments.Add ActiveWorkbook.FullName
        .Send
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Viewing all articles
Browse latest Browse all 88854

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>