Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
193 views
in Technique[技术] by (71.8m points)

excel - Subroutine not working when called, only when executed independently

I built a script which aims to create emails addressed to different people with individual attachments included. I have different subroutines that are called from this Mother Script. It all works perfectly.

Untill the subroutine Distribution is called. It stops at the line of code in bold letters:

'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range
    Dim StrBody As String
    
    StrBody = "<BODY style=font-size:11pt;font-family:Arial>Hi team," & "<br><br>" & _
              "Please find attached the most updated version of the Weekly Report. " & "<br>" & _
              "If you have any doubt or comment, do not hesitate to reach out to us." & "<br><br>" & _
              "Jorge Martinez"
                
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")

    Windows("Free Trade Zone Weekly Reports.xlsm").Activate

    **For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)**

        'Enter the path/file names in the C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = cell.Value
                .CC = "[email protected]"
                .Subject = "Weekly Report " & Date
                Bodyformat = 2
                '.Body = "<BODY style=font-size:11pt;font-family:Arial>Hi team," & "<br><br>" & _
              "Please find attached the most updated version of the Weekly Report " & "<br>" & _
              "If you have any doubt or comment, do not hesitate to reach out to us." & "<br><br>" & cell.Offset(0, -1).Value
                .Importance = 2
                   .HTMLBody = StrBody & cell.Offset(0, -1).Value

                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell

                .Display  'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
End Sub

As you can see I took it from Ron DeBruin's website, which has been a great help. The error the script throws says: no data in selected cells. Which is not accurate as there is data in them.

If I stop the mother script and run this sub routine independently, it goes without any type of issue. My question is, why is this happening? Why does it say that there is no data in the column B, but when I run it it actually finds information?

I thought it would be fixed by activating the workbook that contains the script prior to that line, but no success so far.

question from:https://stackoverflow.com/questions/65921499/subroutine-not-working-when-called-only-when-executed-independently

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

When working with SpecialCells you have to be very careful. Try this

Replace

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

with

Dim rng As Range

On Error Resume Next
Set rng = sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0

If rng Is Nothing Then
    MsgBox "No Range with constants were found"
    Exit Sub
End If

For Each cell In rng

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...