Question

'此代码位于工作簿的模块内 Sub Notes_Email_Excel_Cells2（） Application.WindowState = xlNormal 昏暗的NSession作为对象将NDatabase作为对象调暗将NUIWorkSpace作为对象 Dim NDoc As Object Dim NUIdoc作为对象昏暗的WordApp作为对象 Dim subject As String Dim dd As String Dim stAttachment As String Dim obAttachment As Object，EmbedObject As Object Const EMBED_ATTACHMENT As Long = 1454 Dim Wb As Workbook 昏暗的FirstCell作为范围，LastCell作为范围昏暗的CC（1） CC（1）=“yyy@itc.in”，

    If bIsBookOpen("Daily Beetle Count Report - MMGR.xlsx") = True Then
    Set Wb = Workbooks("Daily Beetle Count Report - MMGR.xlsx")
    Else
    Workbooks.Open ("B:\Sangeet\Daily Beetle Count Report - MMGR.xlsx")
    Set Wb = Workbooks("Daily Beetle Count Report - MMGR.xlsx")
    End If

    Set NSession = CreateObject("Notes.NotesSession")

    'Next line only works with 5.x and above. Replace password with your password



    subject = "HOT SPOTS Infestation " & Now
    Debug.Print subject


    Set NUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
    Set NDatabase = NSession.GetDatabase("", "")
    If Not NDatabase.IsOpen Then NDatabase.OPENMAIL

    'Create a new Lotus Notes document

    Set NDoc = NDatabase.CreateDocument
     stAttachment = ActiveWorkbook.FullName
     Set obAttachment = NDoc.CreateRichTextItem("stAttachment")
     Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)

    With NDoc
        .SendTo = "xxx@itc.in"              'CHANGE RECIPIENT EMAIL ADDRESS
        .CopyTo = ""
        .subject = subject

        'Email body text, including marker text which will be replaced by the Excel cells

        .body = "Dear All," & vbLf & vbLf & "Please find the Hotspot areas" & vbLf & vbLf & _
            "**PASTE HERE**" & vbLf & vbLf & vbLf & vbLf & _
            "Auto Generated Mail. Please Donot Reply."

        .Save True, False
    End With

    'Edit the just-created document to copy and paste the Excel cells into it via Word

    Set NUIdoc = NUIWorkSpace.EDITDocument(True, NDoc)
    With NUIdoc

        'Find the marker text in the Body item

        .GotoField ("Body")
        .FINDSTRING "**PASTE HERE**"
        '.DESELECTALL 'Uncomment to leave the marker text in place (cells are inserted immediately before)

        'Copy Excel cells to clipboard
        Wb.Sheets("HOT SPOT").Activate
        Sheets("HOT SPOT").Range("v2:w21").Copy                  'CHANGE SHEET AND RANGE TO BE COPIED AND PASTED

        'Create a temporary Word Document

        Set WordApp = CreateObject("Word.Application")
        WordApp.Visible = False                                 'True to aid debugging
        WordApp.Documents.Add

        'Paste into Word document and copy to clipboard

        With WordApp.Selection
            .PasteSpecial DataType:=10      'Enum WdPasteDataType: 10 = HTML; 2 = Text; 1 = RTF
            .WholeStory
            .Copy
        End With


        'Paste from clipboard (Word) to Lotus Notes document

        .Paste
        Application.CutCopyMode = False

        WordApp.Quit SaveChanges:=False
        Set WordApp = Nothing

        .Send


        .Close




    End With

    Set NSession = Nothing
    If bIsBookOpen("Daily Beetle Count Report - MMGR.xlsx") Then
    Workbooks("Daily Beetle Count Report - MMGR.xlsx").Close SaveChanges:=False
    Else
    End If




End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

在excel以不可见模式运行的特定时间运行宏的脚本

0 个答案: