对函数使用循环

Posted 2023-05-06

技术标签:

【中文标题】对函数使用循环【英文标题】：Using a loop for a function 【发布时间】：2017-02-13 10:31:02 【问题描述】：

我想为我编写的函数使用循环。

我有一个表 tbl-planung 大约有 65 个条目，我的表单中有一个名为 lstPlanung 的列表框，它显示所有条目。

每个条目都有一个 ID、CompName 和一些与公司相关的邮件地址。

ID         Company            Mail

1          CompName           mail1@compname.com  
                              mail2@compname.com

2          CompName2          mail1@compname2.com
                              mail2@compname2.com
                              mail3@compname2.com

我编写了一个创建邮件并打开 Outlook 的函数，其中所有收件人都与 CompName 匹配。

Private Sub SendKunde_Click()
    Call sendemailKunde
End Sub

功能

Sub sendemailKunde()

    'Empfänger werden ausgelesen und an Outlook übergeben

    Dim ThisDB As DAO.Database
    Set ThisDB = CurrentDb
    Dim d As DAO.Recordset
    Dim q As String
    q = "SELECT DISTINCT [tbl-apartner].[EMail] FROM [tbl-apartner] WHERE [tbl-apartner].[HID] = " & "'" & hid2 & "'" 'sql query
    Set d = ThisDB.OpenRecordset(q, dbOpenDynaset)
    Dim Result As String
    Result = ""

        If d.EOF = False Or d.BOF = False Then 'if-else clause
            d.MoveFirst
           Do While Not d.EOF
              If Result <> "" Then Result = Result & "; "
              Result = Result & d!EMail
              d.MoveNext
           Loop
         End If
    d.Close
    'MsgBox Result 'Testausgabe

    'Empfänger auslesen beendet (Variable Result beinhaltet alle Mailadressen zum Kunden)

Dim strhtml
Dim strHTMLDZ
Dim oOutlook As Outlook.Application
Dim oEmailItem As MailItem

On Error Resume Next    'verhindert Error 429 Outlook nicht geöffnet
Err.Clear
Set oOutlook = GetObject(, "Outlook.Application")

If Err.Number <> 0 Then
    Set oOutlook = New Outlook.Application
End If

' Mail für Zentrale Systeme

strHTML = "<html>"
strHTML = strHTML & "   <head>"
strHTML = strHTML & "   </head>"
strHTML = strHTML & "   <body>"
strHTML = strHTML & "       <span style=""font-size: 12pt; font-family: &quot;Arial&quot;,&quot;sans-serif&quot;;"">"
strHTML = strHTML & "       MAILTEXT-1"
strHTML = strHTML & "       </span>"
strHTML = strHTML & "   </body>"
strHTML = strHTML & "</html>"

' Mail für dezentrale Systeme

strHTMLDZ = strHTMLDZ & "<html>"
strHTMLDZ = strHTMLDZ & "<head>"
strHTMLDZ = strHTMLDZ & "</head>"
strHTMLDZ = strHTMLDZ & "<body>"
strHTMLDZ = strHTMLDZ & "       <span style=""font-size: 12pt; font-family: &quot;Arial&quot;,&quot;sans-serif&quot;;"" > "
strHTMLDZ = strHTMLDZ & "       MAILTEXT-2"
strHTMLDZ = strHTMLDZ & "       </span>"
strHTMLDZ = strHTMLDZ & "   </body>"
strHTMLDZ = strHTMLDZ & "</html>"

Set oEmailItem = oOutlook.CreateItem(olMailItem)
With oEmailItem

'.CC = "TEST@TEST.de" <- optional
'.To = Me.mail2 <- Empfänger = TextBox mail2

.SentOnBehalfOfName = "MAIL@DOM.DE"
.To = Result
.Subject = "SAP Patche - " & sid2 & " am: " & datum2 & " um: " & uhr2 & " Uhr"

If zentral2 < 0 Then
        .HTMLBody = strHTML
    Else
        .HTMLBody = strHTMLDZ
    End If

.Display
End With

Set oEmailItem = Nothing
Set oOutlook = Nothing

End Sub

是否可以将我的函数包装成一个循环，我不必手动选择列表框中的每个条目？

我想到了一个按钮和一个函数sendemailAll，它会在 Outlook 中为我的列表框中的每个 ID 自动打开一封新邮件。

此时我必须选择列表框中的每个条目，单击一个按钮并通过 Outlook 发送邮件。

编辑：

我想到了类似的东西：

Mail1 

ID:1 CompName  TO:  mail1@compname.com;  mail2@compname.com    

Mail2

ID2: CompName2 TO:  mail1@compname2.com; mail2@compname2.com; mail3@compname2.com

R3uK 的解决方案如下所示：

Mail1 

ID:1 CompName  TO:  mail1@compname.com  

Mail2

ID:1 CompName  TO:  mail1@compname.com;  mail2@compname.com   

Mail3

ID2: CompName2 TO:  mail1@compname2.com

Mail4 

ID2: CompName2 TO:  mail1@compname2.com; mail2@compname2.com

Mail5

ID2: CompName2 TO:  mail1@compname2.com; mail2@compname2.com; mail3@compname2.com

【问题讨论】：

循环列表框/记录集没有产生任何结果吗？这就是我想要做的。我需要对表单中的列表框条目进行循环。我想为列表框中的每个 ID 创建一封邮件，包括与该 ID 匹配的每个收件人。好吧谷歌列表框msdn，谷歌如何做到这一点msdn.microsoft.com/en-us/library/bb243789(v=office.12).aspx例如或***.com/questions/2933113/… 【参考方案1】：

是的，你可以，你只需要使用参数创建另一个子

Sub sendemailKunde()
    'Empfänger werden ausgelesen und an Outlook übergeben
    Dim ThisDB As DAO.Database
    Set ThisDB = CurrentDb
    Dim d As DAO.Recordset
    Dim q As String
    Dim Result As String
    Dim IDCompName As String

    q = "SELECT [tbl-apartner].[EMail], [tbl-apartner].[SID] FROM [tbl-apartner] WHERE [tbl-apartner].[HID] = " & "'" & hid2 & "'" & " ORDER BY [tbl-apartner].[SID]" 'sql query
    Set d = ThisDB.OpenRecordset(q, dbOpenDynaset)
    Result = vbNullString

    If d.EOF = False Or d.BOF = False Then 'if-else clause
        d.MoveFirst
        IDCompName = d!SID
        Do While Not d.EOF
            If IDCompName <> d!SID Then
                '''Send the mail here
                If Len(Result) > 2 Then
                    Result = Left(Result, Len(Result) - 2)
                    Send_Mail_for_loop Result
                Else
                End If
                '''Prep result for the next ID
                Result = d!Email & "; "
                IDCompName = d!SID
            Else
                Result = Result & d!Email & "; "
            End If
            d.MoveNext
        Loop
    End If
    d.Close
    'MsgBox Result 'Testausgabe
End Sub

而 sub 函数，您可能必须添加 zentral2 作为参数或将其设置为公共变量以具有该 sub 中的值：

Private Sub Send_Mail_for_loop(ByVal RecipientsMail As String)
    'Empfänger auslesen beendet (Variable Result beinhaltet alle Mailadressen zum Kunden)
    Dim strHTML As String
    Dim strHTMLDZ As String
    Dim oOutlook As Outlook.Application
    Dim oEmailItem As Outlook.MailItem

    On Error Resume Next    'verhindert Error 429 Outlook nicht geöffnet
    Err.Clear
    Set oOutlook = GetObject(, "Outlook.Application")
    If oOutlook Is Nothing Then Set oOutlook = New Outlook.Application
    On Error GoTo 0

    ' Mail für Zentrale Systeme
    strHTML = "<html>"
    strHTML = strHTML & "   <head>"
    strHTML = strHTML & "   </head>"
    strHTML = strHTML & "   <body>"
    strHTML = strHTML & "       <span style=""font-size: 12pt; font-family: &quot;Arial&quot;,&quot;sans-serif&quot;;"">"
    strHTML = strHTML & "       MAILTEXT-1"
    strHTML = strHTML & "       </span>"
    strHTML = strHTML & "   </body>"
    strHTML = strHTML & "</html>"

    ' Mail für dezentrale Systeme
    strHTMLDZ = strHTMLDZ & "<html>"
    strHTMLDZ = strHTMLDZ & "<head>"
    strHTMLDZ = strHTMLDZ & "</head>"
    strHTMLDZ = strHTMLDZ & "<body>"
    strHTMLDZ = strHTMLDZ & "       <span style=""font-size: 12pt; font-family: &quot;Arial&quot;,&quot;sans-serif&quot;;"" > "
    strHTMLDZ = strHTMLDZ & "       MAILTEXT-2"
    strHTMLDZ = strHTMLDZ & "       </span>"
    strHTMLDZ = strHTMLDZ & "   </body>"
    strHTMLDZ = strHTMLDZ & "</html>"

    Set oEmailItem = oOutlook.CreateItem(olMailItem)
    With oEmailItem
        '.CC = "TEST@TEST.de" <- optional
        '.To = Me.mail2 <- Empfänger = TextBox mail2
        .SentOnBehalfOfName = "MAIL@DOM.DE"
        .To = RecipientsMail
        .Subject = "SAP Patche - " & sid2 & " am: " & datum2 & " um: " & uhr2 & " Uhr"
        If zentral2 < 0 Then
            .HTMLBody = strHTML
        Else
            .HTMLBody = strHTMLDZ
        End If
        .Display
    End With

    Set oEmailItem = Nothing
    Set oOutlook = Nothing
End Sub

循环的另一种方法：

Sub sendemailKunde()
    'Empfänger werden ausgelesen und an Outlook übergeben
    Dim ThisDB As DAO.Database
    Set ThisDB = CurrentDb
    Dim d As DAO.Recordset
    Dim q As String
    Dim d2 As DAO.Recordset
    Dim q2 As String
    Dim Result As String
    Dim IDCompName As String

    q = "SELECT DISTINCT [tbl-apartner].[SID] FROM [tbl-apartner] " & _
        "WHERE [tbl-apartner].[HID] = " & "'" & hid2 & "' " & _
        "ORDER BY [tbl-apartner].[SID]" 'sql query
    Set d = ThisDB.OpenRecordset(q, dbOpenDynaset)

    If d.EOF = False Or d.BOF = False Then 'if-else clause
        d.MoveFirst
        Do While Not d.EOF
            Result = vbNullString
            q2 = "SELECT DISTINCT [tbl-apartner].[EMail] FROM [tbl-apartner] " & _
                    "WHERE [tbl-apartner].[HID] = " & "'" & hid2 & "' " & _
                    "AND [tbl-apartner].[SID] = '" & d!SID & _
                    "' ORDER BY [tbl-apartner].[SID]"
            Set d2 = ThisDB.OpenRecordset(q2, dbOpenDynaset)
            If d2.EOF = False Or d2.BOF = False Then
                d2.MoveFirst
                Do While Not d2.EOF
                    Result = Result & d2!Email & "; "
                    d2.MoveNext
                Loop
            End If
            d2.Close
            If Len(Result) > 2 Then
                Result = Left(Result, Len(Result) - 2)
                Send_Mail_for_loop Result
            Else
            End If
            d.MoveNext
        Loop
    End If
    d.Close
    'MsgBox Result 'Testausgabe
End Sub

【讨论】：

循环工作但不正确。 Outlook 正在为每个收件人而不是每个 ID 打开一封新邮件。我想到了一个循环，为列表框中的每个 ID 创建一封邮件。现在 Outlook 正在打开 2 封新邮件。第一封邮件有一个收件人，第二封邮件有两个收件人。 @rel0aded0ne : 我在 ID 上添加了一个测试，以便在发送前编译邮件，您可能需要在查询中按 ID 排序以使其正常工作！我不明白。对我来说，这看起来像是一个错误的循环。是否可以创建一个循环，例如“为 lstPlanung 的每个条目 -> 调用 sendemailAll”来创建我的电子邮件？我尝试了一个 for 循环：For i = 0 To Me!lstPlanung.ListCount - 1 Call sendemailKUNDE Next i 这似乎工作得更好，但函数正在创建邮件数量仅适用于我的第一个列表框条目，而不是每个条目。 Entry1 应该是一封邮件，Entry2 应该是另一封邮件，依此类推。 “IDCompName = d![ID]”是什么意思？我收到运行时错误：运行时错误 3265 - 在此集合中找不到项目。

以上是关于对函数使用循环的主要内容，如果未能解决你的问题，请参考以下文章

Python的函数使用

您如何将其转换为迭代函数而不是使用嵌套循环进行递归？

使用 if 语句循环应用函数的数据帧行

Matlab中用内建函数代替for循环

条件循环函数定义练习