Question

我目前遇到了While和Wend语句的问题但首先让我给出一些背景背景来解释我想要实现的目标。我有一个按钮，我单击并创建一个具有人名的新工作表，并使用自动筛选器从源表复制与它们相关的整行（其名称存在）。这没有任何问题，并且使用下面的代码（你们很多人可能会从Ron Bruin那里认出来）我设法通过点击按钮向所有我添加了类似代码的人发送信息（有点像通用的代码）我在下面提到）但是这提出了一些问题。可以说总共有30个人，人数和名字都是不变的。如果所有名称都显示为工作表，那么我可以毫无问题地发送。问题是这是每月运行的，并且在某些月份并不是所有这30个人都会在表格上。以下为例，这意味着如果John Doe和Jane Doe都有一张包含数据的工作表，我就可以发送，但是如果Jane没有出现在源表中那么代码就会中断。我意识到我需要某种If语句，经过多次尝试后我无法开始工作。然后我发现了While / Wend语句，它似乎是用于此目的的更好选择。从逻辑上讲，我在下面要完成的是＆＃34;虽然有一张名为John Doe＆＃34;然后执行它下面的所有代码，如果条件不是Met，那么在Wend＆＃34;之后继续执行。目前我认为我有一个问题，可能还有两个问题：

首先是在执行代码时我得到一个错误＆＃34;编译错误：没有使用We＆＃34 ;.

根据答案VBA Compile Error 'Wend Without While'，它似乎与未终止的IF语句有关，但似乎并非如此

第二是因为我无法测试是否 while（工作表（＆＃34; John Doe＆＃34;）。姓名＆lt;＆gt;＆＃34; John Doe＆＃34;）是一个有效的while语句，可以按照我的意图使用这样做。

如果有人能够解释为什么这样做不起作用以便我可以从中学习，我将不胜感激。感谢您抽出宝贵时间阅读这篇文章！如果需要其他信息或我写的东西不清楚，请告诉我。

Sub emailfitest()

Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Dim strbody As String

On Error Resume Next

While (Worksheets("John Doe").Name <> "John Doe")

Set rng = Sheets("John Doe").Range("A1:K80").SpecialCells(xlCellTypeVisible)

On Error Resume Next




Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail

    .SentonBehalfofName = "bla@domain.com"
    .To = "blabla@domain.com"
    .CC = ""
    .BCC = ""
    .Subject = "Bla bla 123"
    .WrapText = True

    .HtmlBody = "<HTML><BODY><p> " & strTo & " <br /> " & strCC & " <br /> </p>" & _
    "<p>Hi Bla,  " & " </B>  <br /> <br /< </p>" & _
    "<p>text1<br /> <br /> </p> " & _
    "<p>text2.<br /> </p> " & _
    "<li>bulletpoint 1<br /> </li> " & _
    "<li>bulletpoint2<br /> <br /> </li> " & _
    "<p>text3<br /> </p> " & _
    "<p> text4 <A href=https://blabbla.com>Here</A><br /></p>" & _
    "<p>text5</p> <br /> <br />" & _
    "<p>text6 <br /></p>" & RangetoHTML(rng)
    .Send

   Wend
   End With


On Error GoTo 0

     With Application
        .EnableEvents = True
        .ScreenUpdating = True

Set OutMail = Nothing
Set OutApp = Nothing




While (Worksheets("Jane Doe").Name <> "Jane Doe")
'---------------------------------------------------------------------------------
Set rng = Sheets("Jane Doe").Range("A1:K80").SpecialCells(xlCellTypeVisible)

On Error Resume Next




Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail

    .SentonBehalfofName = "blabla@domain.com"
    .To = "thingsandstuff@domain.com"
    .CC = ""
    .BCC = ""
    .Subject = "hello1233h12"
    .WrapText = True

    .HtmlBody = "<HTML><BODY><p> " & strTo & " <br /> " & strCC & " <br /> </p>" & _
    "<p>Hi Jane" & " </B>  <br /> <br /< </p>" & _
    "<p>text1<br /> <br /> </p> " & _
    "<p>text2<br /> </p> " & _
    "<li>bulletpoint1<br /> </li> " & _
    "<li>bulletpoint2<br /> <br /> </li> " & _
    "<p>text3<br /> </p> " & _
    "<p>blablabla  <A href=https://bblablabsa.com >Here</A><br /></p>" & _
    "<p>text4</p> <br /> <br />" & _
    "<p>text5<br /></p>" & RangetoHTML(rng)
    .Send

Wend

End With

On Error GoTo 0

     With Application
        .EnableEvents = True
        .ScreenUpdating = True

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

   --------------------------------------------
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
End With

'Publish the sheet to a htm file
 With TempWB.PublishObjects.Add( _
     SourceType:=xlSourceRange, _
     Filename:=TempFile, _
     Sheet:=TempWB.Sheets(1).Name, _
     Source:=TempWB.Sheets(1).UsedRange.Address, _
     HtmlType:=xlHtmlStatic)
    .Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                      "align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

Answer 1

您的End With和Wend是错误的。

While (Worksheets("Jane Doe").Name <> "Jane Doe")
...
    With OutMail
    ...
    ...
    End With '// <~~ Close the With block first.
Wend '// <~~ THEN close the While block

你还错过了这个区块的End With：

With Application
    .EnableEvents = True
    .ScreenUpdating = True

这意味着您无法在第二次运行时使用With OutMail，因为您仍在第一个With区域内。

所有With语句必须在块结尾处使用End With完成。

使用while和when编译错误

1 个答案: