Automatische PDF-Erstellung und Mail-Versand aus einem Verzeichnis

' ===========================================  
' Run this script with administrative rights!  
' ===========================================  



'/////////////////////////////// Configure script's job ///////////////////////////////  

'******************** Customize according to your specific needs **********************  

'------------------ Set event description and job related variables -------------------  

strEventDescription  = "New Textfile Creation"  
strMonitorFileSpec   = "E:\Test\*.TIFF"  
strPollingIntervall  = "1"  



'---------------- Prepare Monitor Filespec for WMI Event Filter query -----------------  

Set FSO              = CreateObject("Scripting.FileSystemObject")  

strDrive             = FSO.GetDriveName(strMonitorFileSpec)

strFileName          = FSO.GetFileName(strMonitorFileSpec)
intPathBegin         = Len(strDrive) + 1
intPathLen           = Len(strMonitorFileSpec) - Len(StrDrive) - Len(strFileName)
strPath              = Replace(Mid(strMonitorFileSpec, intPathBegin, intPathLen), "\", "\\")  

strExtension         = FSO.GetExtensionName(strMonitorFileSpec)

Set FSO              = Nothing



'----------------------------- Set WMI Event Filter query -----------------------------  

strEventFilterQuery  = "SELECT * FROM __InstanceCreationEvent" _  
                     & " WITHIN " & strPollingIntervall _  
                     & " WHERE TargetInstance ISA 'CIM_DataFile'" _  
                     & " AND TargetInstance.Drive='" & strDrive & "'" _  
                     & " AND TargetInstance.Path='" & strPath & "'" _  
                     & " AND TargetInstance.Extension='" & strExtension & "'"  



'-------------- Set WMI Namespace where the monitored event will occure ---------------  

strEventNamespace    = "root\Cimv2"  



'----------- Set parameters which should be passed to Event Handler script ------------  

strEventHandlerParam = """" _  
                     & "%TargetInstance.Drive%" _  
                     & "%TargetInstance.Path%" _  
                     & "%TargetInstance.FileName%" _  
                     & "." _  
                     & "%TargetInstance.Extension%" _  
                     & """"  

'**************************************************************************************  





'//////////////////////////////// Set script variables ////////////////////////////////  

'- Set Event Handler path, quote it and prepare it and its working directory for WMI --  

Set FSO           = CreateObject("Scripting.FileSystemObject")  

strEventHandlerWD = Replace(FSO.GetParentFolderName(WScript.ScriptFullName), "\", "\\")  

strEventHandler   = Replace(strEventDescription, " ", "") & "EventHandler.vbs"  
strEventHandler   = """" & strEventHandlerWD & "\\" & strEventHandler & """"  

Set FSO           = Nothing



'----------------------- Test for existing Event Handler script -----------------------  

Set FSO = CreateObject("Scripting.FileSystemObject")  

If Not FSO.FileExists(Replace(Replace(strEventHandler, "\\", "\"), """", "")) Then  
  MsgBox "The Event Handler script " & vbCRLF _  
          & Replace(strEventHandler, "\\", "\") & vbCRLF _  
          & "does not exist. Please create it.", _  
         vbExclamation, _
         "Missing Event Handler script"  
End If

Set FSO = Nothing



'-------------------------- Build parameters for CScript.exe --------------------------  

strCScriptParam = strEventHandler & " " & strEventHandlerParam  



'---------------- Get path of Windows Directory and prepare it for WMI ----------------  

Set WshShell    = WScript.CreateObject("WScript.Shell")  

strWinDir       = Replace(WshShell.ExpandEnvironmentStrings("%SystemRoot%"), "\", "\\")  

Set WshShell    = Nothing
 


'---------------------- Set path of CScript.exe prepared for WMI ----------------------  

setCScriptPath  = strWinDir & "\\System32\\cscript.exe"  





'////////////////////////// Install permanent Event Consumer //////////////////////////  

'------- Get WMI Scripting API object (SWbemServices), Namespace: Subscription --------  

strComputer                          = "."  
Set objWMIService                    = GetObject("winmgmts:" _  
                                                 & "{impersonationLevel=impersonate}!" _  
                                                 & "\\" & strComputer & "\root\Subscription")  



'------------------------------ Create the Event Filter -------------------------------  

Set objFilterClass                   = objWMIService.Get("__EventFilter")  
Set objFilter                        = objFilterClass.SpawnInstance_()

objFilter.Name                       = strEventDescription & " Event Filter"  
objFilter.EventNamespace             = strEventNamespace
objFilter.QueryLanguage              = "WQL"  
objFilter.Query                      = strEventFilterQuery

Set EventFilterPath                  = objFilter.Put_()



'----------------------- Create the Commandline Event Consumer ------------------------  

Set objEventConsumerClass            = objWMIService.Get("CommandLineEventConsumer")  
Set objEventConsumer                 = objEventConsumerClass.SpawnInstance_()

objEventConsumer.Name                = strEventDescription & " Commandline Event Consumer"  
objEventConsumer.CommandLineTemplate = setCScriptPath & " " & strCScriptParam  
objEventConsumer.ExecutablePath      = setCScriptPath
objEventConsumer.WorkingDirectory    = strEventHandlerWD
objEventConsumer.ShowWindowCommand   = 0

Set CommandlineEventConsumerPath     = objEventConsumer.Put_()



'------------------ Bind Event Filter to Commandline Event Consumer -------------------  

Set objBindingClass                  = objWMIService.Get("__FilterToConsumerBinding")  
Set objBinding                       = objBindingClass.SpawnInstance_()

objBinding.Filter                    = EventFilterPath
objBinding.Consumer                  = CommandlineEventConsumerPath

objBinding.Put_()

Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.  
Const cdoSendUsingPort   = 2 'Send the message using the network (SMTP over the network).  

Const cdoAnonymous       = 0 'Do not authenticate  
Const cdoBasic           = 1 'basic (clear-text) authentication  
Const cdoNTLM            = 2 'NTLM  


Set listArgs = WScript.Arguments

If listArgs.Count = 1 Then
  strSenderName     = "Your Name"  
  strSenderEMail    = "YourEMailAddress@Provider.com"  
  strRecipientEMail = "RecipientEMailAddress@Provider.com"  

  strSMTPServer     = "Your.SMTP.Server"  
  intSMTPPort       = 465
  strSMTPUserName   = "YourSMTPUserName"  
  strSMTPPassWord   = "YourSMTPPassword"  

  '  
  '  
  ' Hier Code zum Erzeugen der PDF-Datei einfügen.  
  ' Der Pfad+Name der neu erstellten TIFF-Datei steht in listArgs(0)  
  '  
  '  
  
  strSubject        = "Neue Datei"  
  strMailBody       = "Nachrichtentext"  
  strAttachmentFile = "Laufwerk:\Pfad\Datei.pdf"  'Hier den Pfad zur erzeugten  
                                                  'PDF-Datei einfügen  


  Set objMessage      = CreateObject("CDO.Message")  

  objMessage.Subject  = strSubject
  objMessage.From     = """" & strSenderName & """ <" & strSenderEMail & ">"  
  objMessage.To       = strRecipientEMail
  objMessage.TextBody = strMailBody

  If strAttachmentFile <> "" Then  
    objMessage.AddAttachment strAttachmentFile
  End If
  

  '==This section provides the configuration information for the remote SMTP server.  

  objMessage.Configuration.Fields.Item _
  ("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort  

  'Name or IP of Remote SMTP Server  
  objMessage.Configuration.Fields.Item _
  ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer  

  'Type of authentication, NONE, Basic (Base64 encoded), NTLM  
  objMessage.Configuration.Fields.Item _
  ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic  

  'Your UserID on the SMTP server  
  objMessage.Configuration.Fields.Item _
  ("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSMTPUserName  

  'Your password on the SMTP server  
  objMessage.Configuration.Fields.Item _
  ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSMTPPassWord  

  'Server port (typically 25 or 465 (SMTP over SSL))  
  objMessage.Configuration.Fields.Item _
  ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = intSMTPPort  

  'Use SSL for the connection (False or True)  
  Select Case intSMTPPort
    Case 25 :
      objMessage.Configuration.Fields.Item _
      ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False  

    Case 465:
      objMessage.Configuration.Fields.Item _
      ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True  
      
  End Select

  'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)  
  objMessage.Configuration.Fields.Item _
  ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60  

  objMessage.Configuration.Fields.Update

  '==End remote SMTP server configuration section==  


  objMessage.Send

  Set objMessage = Nothing
End If

Set listArgs = Nothing

Set objFSO   = CreateObject("Scripting.FileSystemObject")  
Set objShell = WScript.CreateObject("WScript.Shell")  
strDestFile  = objFSO.BuildPath("E:\Fax2PDF", objFSO.GetBaseName(listArgs(0)) & ".pdf")  
objShell.Run """%ProgramFiles%\IrfanView\i_view32.exe"" """ & listArgs(0) & """ /ini=""%ProgramFiles%\Automatic-Fax2EMail"" /convert=""" & strDestFile & """", 0, True  

strSubject        = "Neue Datei"  
strMailBody       = "Nachrichtentext"  
strAttachmentFile = strDestFile

Set objFSO   = CreateObject("Scripting.FileSystemObject")  
Set objShell = WScript.CreateObject("WScript.Shell")  
strDestFile  = objFSO.BuildPath("E:\Fax2PDF", objFSO.GetBaseName(listArgs(0)) & ".pdf")  
objShell.Run """%ProgramFiles%\IrfanView\i_view32.exe"" """ & listArgs(0) & """  /convert=""" & strDestFile & """", 0, True  

strSubject        = "Neue Datei"  
strMailBody       = "Nachrichtentext"  
strAttachmentFile = strDestFile