if 语句以防函数失败答案

【问题标题】：If statement in case a function failsif 语句以防函数失败
【发布时间】：2020-11-17 01:03:41
【问题描述】：

我有两个 VBA 函数，它们从 Excel 工作表中收集数据并将其复制到 Outlook。

当工作表为空时，函数会使程序崩溃。

我尝试使用错误语句，但我想要一个 if 语句来验证函数 PegarData1html 和 pegardata2html 是否能够运行。如果没有，请在 htmlbody 上将其留空。

Sub fupautomatico()

    Dim str1 As String
    Dim BaseCell1 As Range
    Dim Basecell2 As Range
    Dim olApp As Outlook.Application
    Dim olEmail As Outlook.MailItem
    Dim today As String

    today = Date + 4
    
    Worksheets("Vencidas").Activate
    str1 = UCase(InputBox("Fornecedor"))

    Set BaseCell1 = Worksheets("Vencidas").Columns("A")
    Set Basecell2 = Worksheets("A vencer").Columns("A")
    If str1 = "" Then
        Exit Sub
    Else
    End If
    BaseCell1.AutoFilter 1, str1, xlFilterValues
    Basecell2.AutoFilter 1, str1, xlFilterValues
    
    Set olApp = New Outlook.Application
    Set olEmail = olApp.CreateItem(olMailItem)
    
    With olEmail
        .BodyFormat = olFormatHTML

        .Display
        .HTMLBody = "<p style=""font-size:15;font-family:Calibri ""> Bom dia ! <br><br> Tudo bem?  <br><br> Pedimos a gentileza de enviarem as repostas dos itens em atraso até a data informada.<br><br> Vencidas: <br><br>" & PegarData1HTML & "<br><br> Prestes a vencer:<br><br>" & PegarData2HTML & "<br><br> OBS: Caso alguma destas RFQs tenha sido respondida nos últimos 2 dias, ainda podem aparecer como pendência, devido ao delay do sistema.<br><br> Gentileza verificar se no próximo relatório já estará correto, e, qualquer problema, por favor, nos avise.<br><br> ATENÇÃO:O envio dessa mensagem é automatico caso haja qualquer problema com o e-mail favor avisar.  </p>" & .HTMLBody

它们的功能几乎相同。这是一个。

Function PegarData1HTML()

     Dim FilmColumn As Range, FilmRow As Range, r As Range, c As Range
     Dim str As String
     Planilha2.Activate
    
     Set FilmColumn = Range("A1", Range("A1").End(xlDown)).SpecialCells(xlCellTypeVisible)

    str = "<table>"

    For Each r In FilmColumn
        str = str & "<tr>"
        
        Set FilmRow = Range(r, r.End(xlToRight))
        
        For Each c In FilmRow
        
            str = str & "<td>" & c.Value & "</td>"

        Next c
        str = str & "</tr>"
    Next r
    str = str & "</table>"

    PegarData1HTML = str

End Function

【问题讨论】：

标签： html vba outlook

【解决方案1】：

为什么不检查excel是否为空？

Function PegarData1HTML()
  Dim FilmColumn As Range, FilmRow As Range, r As Range, c As Range
  Dim str As String
  Dim LastRow as Cells
  Planilha2.Activate

  ' Get the last row number
  LastRow = Cells(sht.Rows.Count, "A").End(xlUp).Row
  if LastRow <= 1 then ' If not validated, exit all
    Debug.print "No data found"
    Exit Function
  End If

  ' I think is the same from what I wrote, but I don't wanna mess your code :)
  Set FilmColumn = Range("A1", Range("A1").End(xlDown)).SpecialCells(xlCellTypeVisible)

  str = "<table>"
  For Each r In FilmColumn
    str = str & "<tr>"
  
    Set FilmRow = Range(r, r.End(xlToRight))
  
    For Each c In FilmRow
      str = str & "<td>" & c.Value & "</td>"
    Next c

  str = str & "</tr>"
  Next r
  str = str & "</table>"

  PegarData1HTML = str
End Function

【讨论】：