Welcome !

 Send several Attachments from one Folder via Lotus Notes

Author Message

  • Total Posts : 1
  • Scores: 0
  • Reward points : 0
  • Joined: 11/29/2016
  • Status: offline
Send several Attachments from one Folder via Lotus Notes Tuesday, November 29, 2016 9:27 PM (permalink)
Hi all,
i need help with a vbs script i build. The aim is to create a Shortcut of all marked Files in a special directory and send this .lnk Files  via the "send to" Function of Windows with Lotus Notes as Attachment in one Email. I got this to work with only one File and i dont know how to do it for several Files. Can somebody help me. Here is the script:
I am a Noob with VBSCript :)
 Option Explicit Dim fso, ws, Args
 Set fso = CreateObject("Scripting.FileSystemObject") 
 Set ws = CreateObject("Wscript.Shell") 
 Set Args = WScript.Arguments 
 'Get Username and Create Folder 
 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") 
 'Check if the Folder exists 
 If NOT oFSO.FolderExists(strPath) Then 
 arrPath = Split(strPath,"\")
 oPath = "C:\Users\%UserName%\Downloads\StN\" 
 For i = 0 To UBound(arrPath) 
 If oPath = "C:\Users\%UserName%\Downloads\StN\" 
 Then             oPath = arrPath(i) 
 Else             oPath = oPath & "\" & arrPath(i) 
 End If 
 If NOT oFSO.FolderExists(oPath) 
 Then             oFSO.CreateFolder(oPath) 
 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 
 'Get Filename and path 
 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,"\","/") 
 ' Save .lnk to Folder 
 Set wshShell = CreateObject( "WScript.Shell" ) 
 strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" ) 
 Dim strDestination 
 Dim strSource 
 Dim strName 
 strName = fName 
 strSource = buf 
 Dim objShortcut 
 Dim objShell 
 Set objShell= WScript.CreateObject("Wscript.Shell") 
 strDestination="C:\Users\" & strUserName & "\Downloads\StN\" 
 Set objShortcut=objShell.CreateShortcut(strDestination & "\" & strName & ".lnk") 
 objShortcut.TargetPath= strSource
 objShortcut.Description= "Automatisch erstellte Verknuepfung" 
 objShortcut.IconLocation = "%SystemRoot%\system32\SHELL32.dll, 144" 
 objShortcut.WorkingDirectory = "" 
 ' Here i have to create Shortcuts from all marked Files 
 'Create Email 
 Dim maildb
 Dim doc 
 Dim AttachME 
 Dim session 
 Dim embedobj 
 Dim was 
 dim uidoc 
 dim Attachment1 

 set  session = CreateObject("Notes.NotesSession") 
 set  maildb  = Session.GetDatabase("","")
 set doc = maildb.CreateDocument 
 'Add Atachment 
 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, "") 
  ' Here i need all Files from the created Folder above
 'Mailbox Settings 
 set was = CreateObject("Notes.NotesUIWorkspace") 
 set uidoc=was.EditDocument(True, doc) uidoc.GotoField "BODY" 
 Set maildb = Nothing 
 Set doc = Nothing 
 Set AttachME = Nothing 
 Set Session = Nothing 
 Set embedobj = Nothing 
 Set was = Nothing 
 Set profile = Nothing 
 Set embedobj = Nothing 
 'maximize Notes 
 Set objShell = CreateObject("WScript.Shell") objShell.AppActivate "IBM Notes" 
 If (objShell.AppActivate("IBM Notes") = False) Then objShell.sendkeys "(%) x"
 Else WScript.Sleep 1000 
 End If 

<message edited by Sentinel87 on Tuesday, November 29, 2016 9:38 PM>
    Online Bookmarks Sharing: Share/Bookmark

    Jump to:

    Current active users

    There are 0 members and 1 guests.

    Icon Legend and Permission

    • New Messages
    • No New Messages
    • Hot Topic w/ New Messages
    • Hot Topic w/o New Messages
    • Locked w/ New Messages
    • Locked w/o New Messages
    • Read Message
    • Post New Thread
    • Reply to message
    • Post New Poll
    • Submit Vote
    • Post reward post
    • Delete my own posts
    • Delete my own threads
    • Rate post

    2000-2017 ASPPlayground.NET Forum Version 3.9