0

エクセルVBA初心者です。Microsoft 2003 エクセルを使用しています。

上司が私に命じたのは、従業員の休暇に関して残りの日数を追跡し、そこから、承認または拒否のステータスに関する電子メールを彼女、彼女の秘書、および従業員に送信する休暇管理システムを作成することでした。 .

VBA のコードをいくつか試してみました。しかし、メール送信機能が実際にどのように機能するのかわかりません。添付ファイルを送信しますか? または、コードに値を入力すると、添付ファイル全体が自動送信されますか? 私はここで本当に迷っています、ありがとう！

Sub Mail_sheets()
Dim MyArr As Variant
Dim last As Long
Dim shname As Long
Dim a As Integer
Dim Arr() As String
Dim N As Integer
Dim strdate As String
For a = 1 To 253 Step 3
    If ThisWorkbook.Sheets("mail").Cells(1, a).Value = "" Then
        Exit Sub
    End
    Application.ScreenUpdating = False
    last = ThisWorkbook.Sheets("mail").Cells(Rows.Count, _
        a).End(xlUp).Row
    N = 0
    For shname = 1 To last
        N = N + 1
        ReDim Preserve Arr(1 To N)
        Arr(N) = ThisWorkbook.Sheets("mail").Cells(shname, a).Value
    Next shname
    ThisWorkbook.Sheets(Arr).Copy
    strdate = Format(Date, "dd-mm-yy") & " " & _
        Format(Time, "h-mm-ss")
    ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
        & " " & strdate & ".xls"
    With ThisWorkbook.Sheets("mail")
        MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, _
            a + 1).End(xlUp))
    End With
    ActiveWorkbook.SendMail MyArr, ThisWorkbook.Sheets("mail").Cells(1, a + 2).Value
    ActiveWorkbook.ChangeFileAccess xlReadOnly
    Kill ActiveWorkbook.FullName
    ActiveWorkbook.Close False
    Application.ScreenUpdating = True
Next a
End Sub
4

1 に答える 1

3

これがあなたが望むものを達成する方法の例です。実際のニーズに合わせて修正してください。

VBAのコードをいくつか試しましたが、メール送信機能が実際にどのように機能するのかわかりません。添付ファイルを送信しますか？

ブック全体を添付ファイルとして送信する必要はありません。休暇が承認されたか拒否されたかを示す簡単なメールを送信できます。休暇を拒否または承認する理由をサポートする必要がある場合は、関連するセルを電子メールに貼り付けることができます。この例を参照してください。

しばらくの間、ワークシートは次のようになっていると思います。

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

ここで、従業員Siddharthが休暇を取りたいとします。スナップショットでわかるように、従業員に0はバランスが取れています。そのため、休暇の申請は拒否され、関係者/部門にメールが送信されます。

コードを実行すると、従業員名を入力するように求められます

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

次に、関連する電子メールを送信します。

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

コード

Option Explicit

'~~> To Field in Email
Const strTo As String = "aaa@aaa.com"
'~~> CC field in email. If you do not want to CC then change "bbb@bbb.com" to ""
Const strCC As String = "bbb@bbb.com"

'~~> This is what goes in the body
Const strBody1 As String = "Dear XYZ,"
Const strBody2 As String = "This is in reference to leave request for employee "

Const strBodyApp As String = "The employee has sufficient leave balance and can take the leave"
Const strBodyNotApp As String = "The employee doesn't have sufficient leave balance and hence cannot take the leave"
Const strByeBye  As String = "Thanks and Regards"
Const sender As String = "ABC"

Sub Sample()
    Dim ws As Worksheet
    Dim aCell As Range
    Dim Ret
    Dim Bal As Long
    Dim Rw As Long

    Ret = Application.InputBox("Please enter the name of the employee who wants to take a leave")

    If Ret = "" Then Exit Sub

    Set ws = Sheets("Sheet3")

    Set aCell = ws.Columns(2).Find(What:=Ret, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
        Bal = aCell.Offset(, 5).Value
        Rw = aCell.Row

        If Bal > 0 Then
            Approved Ret, True, Rw
        Else
            Approved Ret, False, Rw
        End If
    Else
        MsgBox "The employee " & Ret & " was not found"
    End If
End Sub

Sub Approved(EmpName, app As Boolean, lRow As Long)
    Dim msg As String
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    If app = True Then
        msg = "<p class=MsoNormal>" & strBody1 & "<o:p></o:p></p>" & vbNewLine & _
               "<p class=MsoNormal><o:p>&nbsp;</o:p></p>" & vbNewLine & _
               "<p class=MsoNormal>" & strBody2 & EmpName & ". " & strBodyApp & _
               "<span style='mso-fareast-font-family:""Times New Roman""'><o:p></o:p></span></p>"
    Else
        msg = "<p class=MsoNormal>" & strBody1 & "<o:p></o:p></p>" & vbNewLine & _
               "<p class=MsoNormal><o:p>&nbsp;</o:p></p>" & vbNewLine & _
               "<p class=MsoNormal>" & strBody2 & EmpName & ". " & strBodyNotApp & _
               "<span style='mso-fareast-font-family:""Times New Roman""'><o:p></o:p></span></p>"
    End If

    Set rng = Sheets("Sheet3").Range("A1:F1" & ",A" & lRow & ":F" & lRow)

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

    On Error Resume Next
    With OutMail
        .To = strTo
        .CC = strCC
        .BCC = ""
        .Subject = "Leave Status"

        .HTMLBody = msg & _
                    RangetoHTML(rng) & _
                    "<p class=MsoNormal><span style='mso-fareast-font-family:""Times New Roman""'>" & strByeBye & "<o:p></o:p></span></p>" & _
                    "<p class=MsoNormal><span style='mso-fareast-font-family:""Times New Roman""'><o:p>&nbsp;</o:p></span></p>" & _
                    "<p class=MsoNormal><span style='mso-fareast-font-family:""Times New Roman""'>" & sender & "<o:p></o:p></span></p>"

        .Display   '.Send 'To send the email
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

'~~> Taken from http://www.rondebruin.nl/mail/folder3/mail4.htm
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
    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

免責事項：上記のコードは基本的な例であるため、私はしていません

1）含まれているエラー処理（あなたがすべき）

2）基本的なものをApplication.ScreenUpdating

サンプルファイル：このリンクは今後7日間有効になります。私はあなたが遊ぶためのサンプルファイルをアップロードしました:)

http://wikisend.com/download/562482/Sample.xls

HTH

于 2012-04-08T12:22:29.817 に答える