Imports System.IO
Imports Out = Microsoft.Office.Interop.Outlook
Imports Zip
Module Module1
Private OutApp As Out.Application = CreateObject(ProgId:="Outlook.Application")
Sub Main()
Try
'Mail-Objekt anlegen
Dim OutMailItem As Out.MailItem = OutApp.CreateItem(Microsoft.Office.Interop.Outlook.OlItemType.olMailItem)
'Objekteigenschaften festlegen
With OutMailItem
'Wichtigkeit
.Importance = Microsoft.Office.Interop.Outlook.OlImportance.olImportanceNormal
'Weitere Argumente
Dim BodyArg As String = "/body="
Dim SubArg As String = "/subject="
Dim FilesArg As String = "/files="
Dim Empf As String = "/to="
Dim Send As String = "/send="
Dim Pack As String = "/pack="
'Variablen für die Verwendung
Dim Dateien() As String
Dim Volumen As Double = 0
Dim inputName As String = ""
Dim Zip As New Packer
Dim FilesToZip As String
Dim ArchivName As String
'Durchlaufe alle gefundenen Kommandozeilenschalter
For Each s In My.Application.CommandLineArgs
'Text
If s.ToLower.StartsWith(BodyArg) Then
inputName = s.Remove(0, BodyArg.Length)
.Body = inputName
End If
'Betreff
If s.ToLower.StartsWith(SubArg) Then
inputName = s.Remove(0, SubArg.Length)
.Subject = inputName
End If
'Empfänger
If s.ToLower.StartsWith(Empf) Then
inputName = s.Remove(0, Empf.Length)
.To = inputName
End If
'Packen
If s.ToLower.StartsWith(Pack) Then
inputName = s.Remove(0, Pack.Length)
End If
'Anhang
If s.ToLower.StartsWith(FilesArg) Then
inputName = s.Remove(0, FilesArg.Length)
Dateien = Directory.GetFiles(inputName)
Try
'Array durchlaufen
For i = 0 To Dateien.GetUpperBound(0)
.Attachments.Add(Dateien(i))
'Dateigröße bestimmen
Dim Eigenschaften As New FileInfo(Dateien(i))
Volumen = Volumen + Eigenschaften.Length
'Variable auflösen
Eigenschaften = Nothing
Next i
Catch ex As Exception
'Ausgabe Fehlermeldung
MsgBox(ex.Message & " Der aktuelle Anhang hat eine Größe von " & Math.Round((Volumen / 1024 / 1024), 2) & " MB.", MsgBoxStyle.Information Or MsgBoxStyle.SystemModal)
End Try
End If
'Packen
If s.ToLower.StartsWith(Pack) Then
inputName = s.Remove(0, Pack.Length)
'ArchivName = "OutlookMailArchiv_" & Date.Now.Hour & Date.Now.Minute & Date.Now.Second & ".zip"
ArchivName = "Archiv.zip"
If File.Exists(My.Application.Info.DirectoryPath.ToString & "\Archiv.zip") Then
File.Delete(My.Application.Info.DirectoryPath.ToString & "\Archiv.zip")
End If
Try
'Array durchlaufen
Zip.Packen(My.Application.Info.DirectoryPath & "\" & ArchivName, inputName)
.Attachments.Add(My.Application.Info.DirectoryPath & "\" & ArchivName)
Catch ex As Exception
MsgBox(ex.Message.ToString, MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "Hinweis")
End Try
End If
'Automatisches Senden (führt allerdings zu Outlook-Hinweis)
If s.ToLower.StartsWith(Send) Then
inputName = Microsoft.VisualBasic.LCase(s.Remove(0, Send.Length))
If inputName = "true" Then
.Send()
End If
'Bewusst auf FALSE gesetzt
If inputName = "false" Then
.Display()
End If
'Keine Angabe => Mailfenster dennoch anzeigen
If inputName = "" Then
.Display()
End If
End If
Next
.Display()
End With
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation Or MsgBoxStyle.SystemModal, "Hinweis")
End Try
End Sub
End Module
