Lotus Script: @Command

[Balvinder Rayat]

Hi,

I've been able to send emails from excel using lotus notes in image format but i want to send e-mail in bitmap format instead of image. I've figured out on web that there is no such code to automate this thing using excel but simultaneously i got to know that this can be done using lotus script (some agent creation something. I really don't know abt this). Have found below code at http://www-10.lotus.com which i think could be helpful to automate my stuff but don't know how to incorporate this stuff into mine & where to start:

any idea ???

Const KEYEVENTF_KEYUP = &H2

Const VK_RETURN = &H0D

Const VK_MENU = &H12



Declare Sub KeyPress Lib "USER32" Alias "keybd_event" _

(Byval V As Integer, Byval S As Integer, Byval F As Long, Byval X As Long) 





Sub Click(Source As Button)

     Const V = "WinNTIconHidden"

     Dim session As New NotesSession

     If session.GetEnvironmentString(V, True) = "1" Then

          KeyPress VK_MENU, 0, 0, 0

          KeyPress Asc("F"), 0, 0, 0

          KeyPress Asc("F"), 0, KEYEVENTF_KEYUP, 0

          KeyPress VK_MENU, 0, KEYEVENTF_KEYUP, 0

          KeyPress Asc("F"), 0, 0, 0

          KeyPress Asc("F"), 0, KEYEVENTF_KEYUP, 0

          KeyPress Asc("S"), 0, 0, 0

          KeyPress Asc("S"), 0, KEYEVENTF_KEYUP, 0

          KeyPress Asc("B"), 0, 0, 0

          KeyPress Asc("B"), 0, KEYEVENTF_KEYUP, 0

          KeyPress VK_RETURN, 0, 0, 0

          KeyPress VK_RETURN, 0, KEYEVENTF_KEYUP, 0

          session.SetEnvironmentVar V, "0", True

     End If

End Sub

here is the link for this stuff:

http://www-10.lotus.com/ldd/46dom.nsf/c21908baf7e06eb085256a39006eae9f/303b4da06c05621880256d91003824a2?OpenDocument

here is my code till now:

Public Function SendEMail()

Dim thisWB  As String
Dim newWB As String
Dim Email As String
Dim SendTo As String
Dim EmailSubject As String
Dim MyAttachment As String


    thisWB = ActiveWorkbook.Name
    
    On Error Resume Next
    Sheets("tempsheet").Delete
    On Error GoTo 0
    
    Sheets.Add
    ActiveSheet.Name = "tempsheet"
    Sheets("Data").Select
    
    If ActiveSheet.AutoFilterMode Then
        Cells.Select
        On Error Resume Next
        ActiveSheet.ShowAllData
        On Error GoTo 0
    End If
    
    Columns("A:A").Select
    Selection.Copy
    
    Sheets("tempsheet").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    
    If (Cells(1, 1) = "") Then
        lastrow = Cells(1, 1).End(xlDown).Row
        
        If lastrow <> Rows.Count Then
            Range("A1:A" & lastrow - 1).Select
            Selection.Delete Shift:=xlUp
        End If
    
    End If
    
    Columns("A:A").Select
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
    
    Columns("A:A").Delete
    
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    
    lMaxSupp = Cells(Rows.Count, 1).End(xlUp).Row
    
    For suppNo = 2 To lMaxSupp
    
        Windows(thisWB).Activate
        SupName = Sheets("tempsheet").Range("A" & suppNo)
        
        If SupName <> "" Then
            
            Sheets("Data").Select
            Cells.Select
            
            ActiveSheet.Range("$A$1:$E$65000").AutoFilter Field:=1, Criteria1:="=" & SupName
            
            Columns("A:E").Select
            Range(Selection, Selection.End(xlUp)).Select
            Selection.Copy
            Sheets("Sheet5").Select
            Range("A1").Select
            ActiveSheet.Paste
            Cells.Select
            Cells.EntireColumn.AutoFit
            
            'Storing e-mail id into Email variable where email need to be sent
            Email = Range("E2").Value
            
            Range("A2:D2").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Range").Select
            Range("B23").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Range("A1").Select
        End If
            
  
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
   
   '********************************************************************************************
   
SendEMail = True

Dim myRange As Range

'Set E-mail format range
    Worksheets("Range").Activate
    Worksheets("Range").Range("A1:F44").Select
    Worksheets("Range").Range("A1:F44").Copy

'On Error GoTo ErrorMsg
   
    Dim EmailList As Variant
    Dim ws, uidoc, session, db, uidb, NotesAttach, NotesDoc, objShell As Object
    Dim RichTextBody, RichTextAttachment As Object
    Dim server, mailfile, user, usersig As String
    Dim SubjectTxt, MsgTxt As String
           
    Set session = CreateObject("Notes.NotesSession")
    If session Is Nothing Then
        MsgBox "Sorry, unable to instantiate the Notes Session", vbOKOnly, "Unable to Continue"
        SendEMail = False
    End If
   
    user = session.UserName
    usersig = session.CommonUserName
    server = ""
    mailfile = session.GetEnvironmentString("MailFile", True)
   
    Set db = session.GetDatabase(server, mailfile)
    If Not db.IsOpen Then
        Call db.Open("", "")
        Exit Function
    End If
           
    If Not db.IsOpen Then
        MsgBox "Sorry, unable to open: " & mailfile, vbOK, "Unable to Continue"
        SendEMail = False
    End If
    
    Set NotesDoc = db.createdocument
    
    With NotesDoc
        .form = "Memo"
        .Subject = "ECS Transaction Pre-Hit Intimation" 'The subject line in the email
        .Principal = user
        .SendTo = Email  'e-mail ID variable to identify whom email need to be sent
    End With
    
    Set RichTextBody = NotesDoc.CreateRichTextItem("Body")
        
   With NotesDoc
        .computewithform False, False
        .Doc_Category = "Business Secret"
   End With
        
   'Now set the front end stuff
   Set ws = CreateObject("Notes.NotesUIWorkspace")
   If Not ws Is Nothing Then
   Set uidoc = ws.editdocument(True, NotesDoc)
   
    If Not uidoc Is Nothing Then
         If uidoc.editmode Then
           Call uidoc.gotofield("Body")
           Call uidoc.Paste
         End If
     End If
   End If
   
   Call uidoc.SEND
    Call uidoc.Close
   
   With NotesDoc
        .Doc_Category = "Business Secret"
        .PostedDate = Now()
    End With
    
   
   'close connection to free memory
    Set session = Nothing
    Set db = Nothing
    Set NotesAttach = Nothing
    Set NotesDoc = Nothing
    Set uidoc = Nothing
    Set ws = Nothing
    
   
Next
            Sheets("tempsheet").Delete
            Sheets("Total Data").Select
    
            If ActiveSheet.AutoFilterMode Then
                Cells.Select
                ActiveSheet.ShowAllData
            End If
End Function