Attribute VB_Name = "Email"
'"sending email" - sample project, based on OstroSoft SMTP component
'written by Igor Ostrovsky (OstroSoft)
'
'permanent URL for this project is
'http://www.ostrosoft.com/smtp_component/sending_email.asp
'
'OstroSoft SMTP component is available for download at
'http://www.ostrosoft.com/download/smtp_component.zip
'
'email questions, suggestions, comments to info@ostrosoft.com

Option Explicit


'----------------------------------------------------------
'Priprava na odesilani emailu
'----------------------------------------------------------

Public Sub OdesliEmail(p As String, k As Integer, Problem As String)

Dim i As Integer
Dim j As Integer
Dim zacatek As String
Dim konec As String
Dim predmet As String

If (EmailZap = 1) Then

    Frm1.LblSetEmail.Caption = ""

    j = InStr(EmailPredmet, "%%")
    
    zacatek = Left(EmailPredmet, j - 1)
    
    If (j + 2 < Len(EmailPredmet)) Then
        konec = Mid(EmailPredmet, j + 2, Len(EmailPredmet))
    End If
    
    predmet = zacatek & p & konec
    
    If (EmailServer = "") Then
        If (Dir(CestaSoubory & "\RDS-Logy\SystemLog\" & GenerujNazevSouboru(Date) & "_Sys.rds") <> "") Then
            ZapisSystemLog "EMAIL ERROR", "Nepodarilo se odeslat email z duvodu chybejiciho emailoveho Serveru"
        End If
        
        Exit Sub
        
    ElseIf (EmailMailFrom = "") Then
        If (Dir(CestaSoubory & "\RDS-Logy\SystemLog\" & GenerujNazevSouboru(Date) & "_Sys.rds") <> "") Then
            ZapisSystemLog "EMAIL ERROR", "Nepodarilo se odeslat email z duvodu chybejiciho odesilatele"
        End If
        
        Exit Sub
    'ElseIf cmbAuth.ListIndex = 1 And Trim(txtPOPServer) = "" Then
    '    Exit Sub
    End If

    On Error GoTo chyba
    
        If (k < 5) Then
        
            For i = 0 To 9
            
               If (EmailUsr(i, k) = 1) Then
                        
                        EmailToServer k, predmet, EmailUsr(i, 0), Problem
                    
                End If
            
            Next i
        
        Else
            
            If (Frm1.TxtSetETest.Text <> "") Then
                EmailToServer k, predmet, Frm1.TxtSetETest.Text, ""
            Else
                MsgBox "Error: " & Err.Description & vbCrLf & vbCrLf & "    Zadejte prosim emailovou adresu!"
            End If
            
        End If
    
End If

Exit Sub

chyba:

    If (Dir(CestaSoubory & "\RDS-Logy\SystemLog\" & GenerujNazevSouboru(Date) & "_Sys.rds") <> "") Then
        ZapisSystemLog "EMAIL ERROR", "Email se nepodarilo odeslat"
    End If

End Sub


'----------------------------------------------------------
'Odesilani emailu
'----------------------------------------------------------

Public Sub EmailToServer(k As Integer, p As String, EmUsr As String, Problem As String)

    Dim SPom As String
    
    With Frm1.OSMTP
    
        .Server = EmailServer
    
        If EmailAut > 0 Then
            .Username = EmailLogin
            .Password = EmailHeslo
        End If
    
        'If EmailAut = 1 Then
        '    .POPServer = txtPOPServer
        'End If
        
        .AuthenticationType = EmailAut
        .MailFrom = EmailMailFrom
        .MessageSubject = p
        
        .SendTo = EmUsr
        
        Select Case k
        
            Case 1:
                .MessageText = Problem
            Case 2:
                If (Dir(CestaSoubory & "\RDS-Logy\Odvysilano\Texty\" & GenerujNazevSouboru(DateAdd("d", -1, Date)) & ".rds") <> "") Then
                    .MessageText = "Byl vam dorucen vypis odvysilanych dennich textu ze dne " & DateAdd("d", -1, Date) & "."
                    .Attachments.Add CestaSoubory & "\RDS-Logy\Odvysilano\Texty\" & GenerujNazevSouboru(DateAdd("d", -1, Date)) & ".rds"
                Else
                    .MessageText = "Soubor dennich textu odvysilanych dne " & DateAdd("d", -1, Date) & " nebyl nalezen."
                End If
            Case 3:
                If (Dir(CestaSoubory & "\RDS-Logy\Odvysilano\Promo\" & GenerujNazevSouboru(DateAdd("d", -1, Date)) & "_Promo.rds") <> "") Then
                    .MessageText = "Byl vam dorucen vypis odvysilanych prom ze dne " & DateAdd("d", -1, Date) & "."
                    .Attachments.Add CestaSoubory & "\RDS-Logy\Odvysilano\Promo\" & GenerujNazevSouboru(DateAdd("d", -1, Date)) & "_Promo.rds"
                Else
                    .MessageText = "Soubor promo textu odvysilanych dne " & DateAdd("d", -1, Date) & " nebyl nalezen."
                End If
            Case 4:
                If (Dir(CestaSoubory & "\RDS-Logy\SystemLog\" & GenerujNazevSouboru(DateAdd("d", -1, Date)) & "_Sys.rds") <> "") Then
                    .MessageText = "Byl vam dorucen systemovy Log ze dne " & DateAdd("d", -1, Date) & "."
                    .Attachments.Add CestaSoubory & "\RDS-Logy\SystemLog\" & GenerujNazevSouboru(DateAdd("d", -1, Date)) & "_Sys.rds"
                Else
                    .MessageText = "Soubor systemoveho Logu ze dne " & DateAdd("d", -1, Date) & " nebyl nalezen."
                End If
            Case 5:
                .MessageText = "Test emailu probehl uspesne."
        End Select
        
        .SendEmail
         
    End With


End Sub

