Erstellen Sie ein Urlaub Abwesenheit System mit Excel?

Question

Ich bin völlig neu in Excel VBA. Ich verwende Microsoft 2003 Excel.

Was ich von meinem Vorgesetzten beauftragt wurde, war die Einrichtung eines Urlaubsmanagementsystems, das die Abwesenheitstage eines Mitarbeiters aufspürt und von dort aus eine E-Mail an sie, ihre Sekretärin und den Angestellten bezüglich des Status sendet genehmigt oder abgelehnt.

Ich habe einige Codes von VBA ausprobiert .. Aber ich weiß nicht, wie wirklich die Mail-Sende-Funktion funktioniert? Schicke ich den Anhang raus? Oder wenn ich einen Wert im Code eingegeben habe, wird automatisch der gesamte Anhang gesendet? Ich bin wirklich hier verloren, danke!

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 

Answer 1

Hier ist ein Beispiel, wie Sie erreichen können, was Sie wollen. Bitte ändern Sie es für Ihre tatsächlichen Bedürfnisse.

Ich habe einige Codes von VBA ausprobieren .. Aber ich weiß nicht, wie wirklich die Post funktioniert Funktion sendet? Schicke ich den Anhang raus?

Sie brauchen nicht die gesamte Arbeitsmappe als Anhang zu senden. Sie können eine einfache E-Mail senden, in der Sie angeben, ob der Urlaub genehmigt oder abgelehnt wird. Wenn Sie unterstützen möchten, warum Sie den Urlaub ablehnen oder genehmigen, können Sie die entsprechenden Zellen in die E-Mail einfügen. Siehe dieses Beispiel.

Ich nehme für einen Moment an, dass Ihr Arbeitsblatt so aussieht.

Nehmen wir nun an die Mitarbeiter Siddharth will einen Urlaub nehmen. Wie wir in der Momentaufnahme sehen können, hat der Mitarbeiter 0 Blattsaldo. So ist der Antrag auf Zulassung wird abgelehnt und eine Mail an die betreffende Person erschossen/Dept

Wenn Sie den Code ausführen, werden Sie gefragt, die Mitarbeiter

Namen eingeben und dann sendet die entsprechende E-Mail.

CODE

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 

HAFTUNGSAUSSCHLUSS: Da der obige Code ein einfaches Beispiel ist, habe ich nicht

1) inklusive Fehlerbehandlung (die Sie sollten)

2) verwendete grundlegende Sachen wie Application.ScreenUpdating

Beispieldatei: Dieser Link ist für die nächsten 7 Tage aktiv.Ich habe eine Beispieldatei hochgeladen für Sie :)

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

HTH