VBS Script zum versenden mehrerer Verknüpfungen zu Dateien per Lotus Notes

'******************************************'  
' File Name: Send to Nodes.vbs             '  
' Überarbeite Version von Copy to Clipboard'  
' Datum 25.11.16						   '  
'******************************************'  

Option Explicit
Dim fso, ws, Args
Set fso = CreateObject("Scripting.FileSystemObject")  
Set ws = CreateObject("Wscript.Shell")  
Set Args = WScript.Arguments

'********** Benutzernamen auslesen und Ordner im User Download Ordner "StN" erstellen  *********'  

Dim strUsername 
Dim strPath
Dim oFSO
Dim arrPath
Dim oPath
Set wshShell = CreateObject( "WScript.Shell" )  
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )  

strPath = "C:\Users\" & strUserName & "\Downloads\StN\"  

Set oFSO = CreateObject("Scripting.FileSystemObject")  

' prüfen ob der Pfad existiert.  
' Wenn er nicht existiert, weitermachen...  
If NOT oFSO.FolderExists(strPath) Then
    ' ...Pfad zerlegen und nach und nach zusammen setzen  
    arrPath = Split(strPath,"\")  
    oPath = "C:\Users\%UserName%\Downloads\StN\" 					  
    For i = 0 To UBound(arrPath)
        ' sicherstellen das der Pfad richtig zusammengesetzt wird  
        If oPath = "C:\Users\%UserName%\Downloads\StN\" Then  
            oPath = arrPath(i)
		Else
            oPath = oPath & "\" & arrPath(i)  
        End If
        ' prüfen ob der zusammengesetzte Pfad existiert  
        ' Wenn er nicht existiert, Pfad erstellen,  
        ' sonst weitermachen mit dem nächsten...  
        If NOT oFSO.FolderExists(oPath) Then
            oFSO.CreateFolder(oPath)
        End If
    Next
End If

Set oFSO = Nothing
Set StrUsername = Nothing
Set StrPath = Nothing
Set oPath = Nothing


Sub Cleanup
  Set ws = Nothing
  Set fso = Nothing
  Set Args = Nothing
  WScript.Quit
End Sub  

'*************************** Dateinamen und Pfad ermitteln - Dies habe ich aus einem vorhandenen Script übernommen*******************************************  
' Hier bräuchte ich die Möglichkeit die Namen und Pfade mehrerer markierter Daten auszulesen und  später im Script korrekt, nacheinander, in die Verknüpfungen zu übergeben  

Dim buf
Dim buf1
Dim fName
Dim wshShell

fName = fso.GetFileName(Args(0))
buf1 = replace (Args(0),"ä","%C3%A4")  
buf1 = replace (buf1,"ö","%C3%B6")  
buf1 = replace (buf1,"ü","%C3%BC")  
buf1 = replace (buf1,"Ä","%C3%84")  
buf1 = replace (buf1,"Ö","%C3%96")  
buf1 = replace (buf1,"Ü","%C3%9C")  
buf1 = replace (buf1,"ß","%C3%9F")  
'buf1 = replace (buf1," ","%20")  
buf = ""																				  
buf = buf & Replace(buf1,"\","/")   


'******************** Verknüpfung der ausgewählten Datei in einem bestimmten Verz. (strLPfad) erstellen *************  
Set wshShell = CreateObject( "WScript.Shell" )  
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )  

Dim strDestination
Dim strSource
Dim strName
strName = fName															'Name der Verknüpfung  
strSource = buf 																'Ausgelesener Pfad  
Dim objShortcut
Dim objShell
Set objShell= WScript.CreateObject("Wscript.Shell")  
strDestination="C:\Users\" & strUserName & "\Downloads\StN\" 					'Erstellungsort der Verknüpfung  
Set objShortcut=objShell.CreateShortcut(strDestination & "\" & strName & ".lnk")  
objShortcut.TargetPath= strSource 																														
objShortcut.Description= "Automatisch erstellte Verknuepfung"  
objShortcut.IconLocation = "%SystemRoot%\system32\SHELL32.dll, 144"  
objShortcut.WorkingDirectory = ""  
objShortcut.Save


'********************** Email erstellen / Anhang hinzufügen***********************************************  
' Hier brauche ich Hilfe bei der Erstellung mehrerer Anhänge. Ich habe mir hierbei gedacht alle erstellten .lnk Files an die Email anzuhängen, da Sie am Ende des Scripts ehe gelöscht werden  


Dim maildb    		
Dim doc    		
Dim AttachME    	
Dim session    		
Dim embedobj    	
Dim was    		
dim profile 		
dim uidoc 			
dim Attachment1
dim Attachment2


set  session = CreateObject("Notes.NotesSession")   
set  maildb  = Session.GetDatabase("","")   
maildb.OpenMail 

set doc = maildb.CreateDocument 

'Fügt Dateianhang hinzu  
Attachment1 = "C:\Users\" & strUserName & "\Downloads\StN\" & "\" & strName & ".lnk"    
Set AttachME = doc.CREATERICHTEXTITEM("Body")  
Call AttachME.ADDNEWLINE(1)
Call AttachME.APPENDTEXT("Die erstellte Verknuepfung verweist auf eine Datei unter folgendem Pfad:" &  vbCrLf & buf)  
Call AttachME.ADDNEWLINE(2)
Set embedobj = AttachME.EmbedObject(1454, "Body", Attachment1, "")  

'Mailbox Einstellungen  

set was = CreateObject("Notes.NotesUIWorkspace")   
set uidoc=was.EditDocument(True, doc)
uidoc.GotoField "BODY"  

'Cleanup  
Set maildb = Nothing
Set doc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set embedobj = Nothing
Set was = Nothing     
Set profile = Nothing                 
Set embedobj = Nothing     

'************************Notes in den Vordergrund holen *****************************************************  

Set objShell = CreateObject("WScript.Shell")  
objShell.AppActivate "IBM Notes"  

If (objShell.AppActivate("IBM Notes") = False) Then  
objShell.sendkeys "(%) x"  '...maximieren  
Else
WScript.Sleep 1000
End If

'Alle Dateien im angelegten Ordner löschen  

Dim Sh
Dim fsos 
 
Set fsos = CreateObject("Scripting.FileSystemObject")  
Set Sh = WScript.CreateObject("wscript.shell")  
 
On Error Resume Next
 
fso.deleteFile ("C:\Users\" & strUserName & "\Downloads\StN\*.lnk")  

'Cleanup  
Set Sh = Nothing
Set fsos = Nothing