0

現在、データベースのExcelスプレッドシートに取り組んでおり、現在VBAを使用してシステムにいくつかの自動機能を実装しています。私はVBAを初めて使用するので、あなたの助けが必要です:)

私の質問はこれです：ユーザーがドロップリストから「完了」または「進行中」を選択する必要がある彫像の列があります。特定の列（例S3）で「Complete」という単語をスキャンできるプログラムが必要です。単語が検出されると、システムは自動的に特定のユーザーにタスクが完了したことを知らせる電子メールを送信します。

誰か助けてもらえますか？

ありがとう！:)

更新：「complete」という単語を検索してユーザーにメールを送信するために、次のようにコーディングしました（これは大まかなアイデアです）

Sub For_Loop_With_Step()

    Dim lCount As Long, lNum As Long
    Dim MyCount As Long

    MyCount = Application.CountA(Range("S:S"))

    For lCount = 1 To MyCount - 1 Step 1
    If Cells(lCount + 2, 19) = "Complete" Then
    Call Send_Email_Using_VBA
    Else
    MsgBox "Nothing found"
    End If

    Next lCount



    MsgBox "The For loop made " & lNum & " loop(s). lNum is equal to " & lNum

End Sub

。 

Sub Send_Email_Using_VBA()

    Dim Email_Subject, Email_Send_From, Email_Send_To, _
    Email_Cc, Email_Bcc, Email_Body As String
    Dim Mail_Object, Mail_Single As Variant
    Email_Subject = "Testing Results"
    Email_Send_From = "fromperson@example.com"
    Email_Send_To = "toperson@example.com"
    'Email_Cc = "someone@example.com"
    'Email_Bcc = "someoneelse@example.com"
    Email_Body = "Congratulations!!!! You have successfully sent an e-mail using VBA !!!!"
    On Error GoTo debugs
    Set Mail_Object = CreateObject("Outlook.Application")
    Set Mail_Single = Mail_Object.CreateItem(0)
    With Mail_Single
    .Subject = Email_Subject
    .To = Email_Send_To
    .cc = Email_Cc
    .BCC = Email_Bcc
    .Body = Email_Body
    .send
    End With
    debugs:
    If Err.Description <> "" Then MsgBox Err.Description
End Sub

ここに画像の説明を入力してください

4

1 に答える 1

0

これを試してください（試してテストしました）

スクリーンショット：

ここに画像の説明を入力してください

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long, lRow As Long
    Dim ExitLoop As Boolean
    Dim aCell As Range, bCell As Range

    '~~> Set this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Find the word in the relevant column. 19 is S Column
        Set aCell = .Columns(19).Find(What:="Complete", LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            '~~> Update Col T appropriately
            '~~> This is required so that mail doesn't go for the same row again
            '~~> When you run the macro again

            Set bCell = aCell

            If Not .Range("T" & aCell.Row).Value = "Mail Sent" Then
                If SendEmail = True Then
                    .Range("T" & aCell.Row).Value = "Mail Sent"
                Else
                    .Range("T" & aCell.Row).Value = "Error: Mail Not Sent"
                End If
            End If

            Do While ExitLoop = False
               Set aCell = .Columns(19).FindNext(After:=aCell)

               If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do

                    If Not .Range("T" & aCell.Row).Value = "Mail Sent" Then
                        If SendEmail = True Then
                            .Range("T" & aCell.Row).Value = "Mail Sent"
                        Else
                            .Range("T" & aCell.Row).Value = "Error: Mail Not Sent"
                        End If
                    End If
               Else
                   ExitLoop = True
               End If
            Loop
        End If
    End With
End Sub

Function SendEmail() As Boolean
    Dim OutApp As Object, OutMail As Object

    On Error GoTo Whoa

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

    With OutMail
        .To = "toperson@example.com"
        .Subject = "Testing Results"
        .Body = "Your Message Goes Here"
        .Display
    End With

    DoEvents

    SendEmail = True

LetsContinue:
    On Error Resume Next
    Set OutMail = Nothing
    Set OutApp = Nothing
    On Error GoTo 0

    Exit Function
Whoa:
    SendEmail = False
    Resume LetsContinue
End Function
于 2013-01-15T16:23:45.283 に答える