FTP via Outlook - Builder.cz - Informacni server o programovani

3. dubna 2000, 00.00 | Některé FTP servery nabízejí možnost zaslat soubor pomocí e-mailu. V tomto tipu uvidite jak tuto službu můžete implementovat do Outlooku 2000.

Některé FTP servery nabízejí možnost zaslat soubor pomocí e-mailu. V tomto tipu uvidite jak tuto službu můžete implementovat do Outlooku 2000.

V události Application_NewMail necháte spustit proceduru subFTP. Událost Application_NewMail se vyvolá, když přijde nová zpráva. Procedura subFTP prohledává nově došlé e-maily a hledá ty, které mají jako předmět slovo FTP. Pokud takový e-mail najde předá ho proceduře subFindPath, která hledá cestu k souboru, který se má poslat. Cesta k soboru je uvozena znaky #. Příklad: #c:\dokumenty\dopis.doc#. Pokud je cesta nalezena předá se proceduře subSendFile. V této proceduře se vytvoří nový e-mail a otestuje se existence požadovaného souboru. Pokud soubor existuje pošle se v příloze, nebo se pošle hláška, že soubor nelze najít.

Procedura subFTP

Public Sub subFTP()
  Dim new_mail As Outlook.MailItem
  For Each new_mail In 
    Application.GetNamespace("MAPI").
       GetDefaultFolder(olFolderInbox).Items
	
    ' hledáme novou zprávu s předmětem ftp
    If new_mail.UnRead And LCase(new_mail.Subject) = "ftp" Then
       subFindPath new_mail
       ' označíme ji jako přečtenou
       new_mail.UnRead = False
    End If
  Next new_mail
End Sub

Procedura subFindPath

Public Sub subFindPath(mess As Outlook.MailItem)
 ' Text zprávy
 Dim MailText As String
 ' cesta k souboru
 Dim PathText As String
 ' počítadlo
 Dim i As Integer
    
 MailText = mess.Body
 For i = 1 To Len(MailText)
   If Mid(MailText, i, 1) = "#" Then
    ' posuneme se o znak za #
    i = i + 1
    Do Until Mid(MailText, i, 1) = "#"
    PathText = PathText & Mid(MailText, i, 1)
    i = i + 1
    Loop
    ' vyskočíme ze smyčky
    Exit For
   End If
  Next i
 If Len(PathText) > 0 Then subSendFile PathText
End Sub

Procedura subFindPath

Public Sub subSendFile(f As String)
  ' nazapomeňte nastavit odkaz na Microsoft Scripting Runtime
  ' nabídka Tolls -> References
  Dim fso As New FileSystemObject
    
  ' Objekt pro e-mailovou zprávu
  Dim objEMail As Outlook.MailItem
    
  ' Vytvoření nového e-mailu
  Set objEMail = Application.CreateItem(olMailItem)
    
  ' Nastavení vlastností e-mailu
  With objEMail
   ' Přidání adresáta - aby nám nikdo nevykrádal počítač
   ' posíláme e-mail na předem danou adresu
   .Recipients.Add ""
   ' Předmět e-mailu
   .Subject = "FTP"
   ' test zda soubor existuje
   If fso.FileExists(f) Then
     .Body = "V příloze naleznete požadovaný soubor."
     ' přidání souboru do e-mailu
     .Attachments.Add f
    Else
     ' Text e-mailu
     .Body = "Soubor " & f & " nenalezen."
   End If
   ' Odeslání
   .Send
  End With
End Sub

Testováno a odladěno: MS Outlook 2000