.FINDSTRING Lotus Notes VBA

lu fim · Sep 12, 2016

So I'm using Excel to do some routines for me, and send an Email every mourning with the data the routine has extracted from SAP. This data includes coping 2 images, and a graph.

The problem is, that when I dont have notes logged in, the macro runs smoothly, but when it is already open, the ".FINDSTRING" cannot find the specific text I had inserted to paste the images.

I'm not sure why, I'm guessing I need a command to select the lotus and turn it active so the findstring could work, but I dont know what to do.

Here's a piece of the coding:

Code:

    '________________________________________________________________________
        Windows(FileHoje).Activate
            Columns("A:N").Select
            Range("A2").Activate
            Selection.ColumnWidth = 10
            Columns("G:G").Select
            Selection.ColumnWidth = 2.14
            Columns("C:C").EntireColumn.AutoFit
            Columns("K:K").EntireColumn.AutoFit
        '________________________________________________________________________
        Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        
        Set NUIdoc = NUIWorkSpace.EDITDocument(True, NDoc)
        With NUIdoc
        
        .GotoField ("Body")
        .FINDSTRING "**1**"
        
        Windows(wb).Activate
            Sheets("Indicadores").Select
        '    ActiveSheet.PivotTables("Tabela dinâmica1").PivotFields("Semana").CurrentPage = Range("AV23").Value
            ActiveSheet.Shapes("Grupo 3").Select
            ActiveWindow.WindowState = xlNormal
            ActiveWindow.WindowState = xlMaximized
            Selection.Copy
        
        .Paste
        Application.CutCopyMode = False
        '________________________________________________________________________
        
        .GotoField ("Body")
        .FINDSTRING "**2**"
        
        Windows(FileHoje).Activate
        Dim LR As Integer
        LR = Range("H" & Rows.Count).End(xlUp).row
        Range("H1:N" & LR).Select
        Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        
        .Paste
        Application.CutCopyMode = False
        
        
        '________________________________________________________________________
        .GotoField ("Body")
        .FINDSTRING "**3**"
        
        Windows(FileHoje).Activate
        Dim LW As Integer
        LW = Range("A" & Rows.Count).End(xlUp).row
        Range("A1:F" & LW).Select
        Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        
        .Paste
        Application.CutCopyMode = False
        
        '________________________________________________________________________
        
        Windows(FileHoje).Activate
            Range("A9").Select
            Range("A2:N60000").Select
            Selection.Interior.ColorIndex = 2
            Range("O1").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Interior.ColorIndex = 15
            Range("A2").Select
        Workbooks(FileHoje).Close SaveChanges:=True
        '________________________________________________________________________
        
                If attachmentFile <> "" Then
                    If Dir(attachmentFile) <> "" Then
                        Set Attachment = .Document.CreateRichTextItem("Attachment")
                        .InsertText String(2, vbLf) & "File attached: " & Mid(attachmentFile, InStrRev(attachmentFile, "\") + 1)
                        Attachment.EmbedObject EMBED_ATTACHMENT, "", attachmentFile
                    Else
                        MsgBox "Arquivo" & attachmentFile & " Não encontrado, não foi adicionado em anexo."
                    End If
                End If
        '________________________________________________________________________
        .Send
        .Close
        End With
        
        
        Set NSession = Nothing
        
        Kill attachmentFile
        
         Application.DisplayAlerts = True
            Application.ScreenUpdating = True
        
        End Sub

I need for this to run without the problem of it not finding the string.

John_w · Sep 15, 2016

I think you are correct that the Notes window must be active before calling the FindString method of NotesUIWorkspace.EditDocument. The following code restores the Notes window - paste it into a new module:

Code:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function IsIconic Lib "user32" (ByVal hWnd As LongPtr) As Boolean
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Boolean
    Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

Private Const SW_RESTORE = 9
Private Const WM_SYSCOMMAND = &H112
Private Const SC_RESTORE = &HF120


Public Sub Find_and_Restore_Lotus_Notes_Window()

    #If VBA7 Then
        Dim hWnd As LongPtr
    #Else
        Dim hWnd As Long
    #End If
    
    'Find main Lotus Notes window - it has class name "NOTES"
    
    hWnd = FindWindow("NOTES", vbNullString)
    
    If hWnd > 0 Then
        If IsIconic(hWnd) Then
            ShowWindow hWnd, SW_RESTORE
            'SetForegroundWindow hWnd
        Else
            PostMessage hWnd, WM_SYSCOMMAND, SC_RESTORE, 0&
            'SetForegroundWindow hWnd
        End If
    End If
    
End Sub

In the above code you might need to uncomment the two SetForegroundWindow calls. In your own code, call Find_and_Restore_Lotus_Notes_Window before your code accesses any Notes objects.

lu fim · Sep 16, 2016

I'm sorry, I'm really not familiar with Lotus codes, I have to copy this into a new module, and run it before I run my already existing code?

John_w · Sep 16, 2016

It isn't Lotus code. Copy the code into a new module and modify your existing VBA routine to call Find_and_Restore_Lotus_Notes_Window at an appropriate place in the code. Since you haven't posted your entire code, I can't tell you exactly where to place the call, but it should be something like this:

Code:

Sub Your_VBA_Routine()

    Dim NSession As Object
    Dim NUIWorkSpace As Object
    
    '--- Some of your code here maybe?
    
    Find_and_Restore_Lotus_Notes_Window
    
    'Create Lotus objects
    
    Set NSession = CreateObject("Notes.NotesSession")
    Set NUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")

    '--- The rest of your code here
    
End Sub

lu fim · Sep 27, 2016

Here's the whole code:

Code:

Sub Notes_Email_Excel_Cells()


 Application.DisplayAlerts = False
    Application.ScreenUpdating = False


Const EMBED_ATTACHMENT As Long = 1454
Dim NSession As Object
Dim NDatabase As Object
Dim NUIWorkSpace As Object
Dim NDoc As Object
Dim NUIdoc As Object
Dim Attachment As Object


'Crating attachment
'__________________________________________________________________________________
wb = ThisWorkbook.Name
Const csPath As String = "I:\Areas\Planejamento\Controle\Rotinas\"
attachmentFile = "I:\Areas\Planejamento\Controle\Rotinas\Pedido.xls"


Workbooks.Add
Range("A1").Select
ActiveWorkbook.SaveAs Filename:=csPath & "Pedido.xls"


Windows(wb).Activate
Sheets("Resultado").Select
Dim LL As Integer
LL = Range("C" & Rows.Count).End(xlUp).row
    
Range("C1:L" & LL).Select
Selection.Copy


Windows("Pedido.xls").Activate
Range("A1").Select
ActiveSheet.Paste


Windows(wb).Activate
Sheets("Resultado").Select
Dim WW As Integer
WW = Range("N" & Rows.Count).End(xlUp).row
Range("N1:U" & WW).Select
Selection.Copy


Windows("Pedido.xls").Activate
Range("L1").Select
ActiveSheet.Paste


Columns("E:E").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
Workbooks("Pedido.xls").Close SaveChanges:=True


'Starting Notes Session
'__________________________________________________________________________________________


Set NSession = CreateObject("Notes.NotesSession")
Set NUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
Set NDatabase = NSession.GETDATABASE("", "")


If Not NDatabase.IsOpen Then
NDatabase.OPENMAIL
End If


'Create a new document
'__________________________________________________________________________________________
Set NDoc = NDatabase.CreateDocument


With NDoc
.SendTo = Range("A16").Value & ", " _
& Range("A17").Value & ", " _
& Range("A18").Value & ", " _
& Range("A19").Value & ", " _
& Range("A20").Value & ", " _
& Range("A21").Value & ", " _
& Range("A22").Value & ", " _
& Range("A23").Value & ", " _


.CopyTo = ""
.subject = "Balcão/SAS " & Now


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


.Body = "Olá, Bom dia. Seguem as ordens Balcão e SAS, favor pedir pagamento:" & vbNewLine & "**1**" & vbNewLine & "**2**" & vbNewLine & vbNewLine & _
"Att, Lucas Fim Cabreira"


.Save True, False
End With


'Pasting Images into body
'__________________________________________________________________________________________
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture


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


.GotoField ("Body")
.FINDSTRING "**1**"


Dim LR As Integer
LR = Range("C" & Rows.Count).End(xlUp).row
Range("C1:L" & LR).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture


.Paste
Application.CutCopyMode = False


'--------------------------------------------


.GotoField ("Body")
.FINDSTRING "**2**"


Dim LW As Integer


LW = Range("N" & Rows.Count).End(xlUp).row
Range("N1:U" & LW).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture


.Paste
Application.CutCopyMode = False


'Attaching file
'__________________________________________________________________________________________
        If attachmentFile <> "" Then
            If Dir(attachmentFile) <> "" Then
                Set Attachment = .Document.CreateRichTextItem("Attachment")
                .InsertText String(2, vbLf) & "File attached: " & Mid(attachmentFile, InStrRev(attachmentFile, "\") + 1)
                Attachment.EmbedObject EMBED_ATTACHMENT, "", attachmentFile
            Else
                MsgBox "Arquivo" & attachmentFile & " Não encontrado, não foi adicionado em anexo."
            End If
        End If
'__________________________________________________________________________________________


.send
.Close
End With




Set NSession = Nothing
Range("A15").Select
Kill "I:\Areas\Planejamento\Controle\Rotinas\Pedido.xls"


 Application.DisplayAlerts = True
    Application.ScreenUpdating = True


End Sub

John_w · Sep 27, 2016

As I said in my previous reply, try it just before the Set NSession line.

lu fim · Oct 13, 2016

It didnt work, shows me the window "sub or function not defined".

This is what you suggested?

Code:

Sub Notes_Email_Excel_Cells()


 Application.DisplayAlerts = False
    Application.ScreenUpdating = False


Const EMBED_ATTACHMENT As Long = 1454
Dim NSession As Object
Dim NDatabase As Object
Dim NUIWorkSpace As Object
Dim NDoc As Object
Dim NUIdoc As Object
Dim Attachment As Object


'Creating attachment
'__________________________________________________________________________________
wb = ThisWorkbook.Name
Const csPath As String = "I:\Areas\Planejamento\Planejamento PGF\02. Programação\02.MSA\02.HEIJUNKA\Balcao_SAS\"
attachmentFile = "I:\Areas\Planejamento\Planejamento PGF\02. Programação\02.MSA\02.HEIJUNKA\Balcao_SAS\Pedido.xls"


Workbooks.Add
Range("A1").Select
ActiveWorkbook.SaveAs Filename:=csPath & "Pedido.xls"


Windows(wb).Activate
Sheets("Resultado").Select
Dim LL As Integer
LL = Range("C" & Rows.Count).End(xlUp).row
    
Range("C1:L" & LL).Select
Selection.Copy


Windows("Pedido.xls").Activate
Range("A1").Select
ActiveSheet.Paste


Windows(wb).Activate
Sheets("Resultado").Select
Dim WW As Integer
WW = Range("N" & Rows.Count).End(xlUp).row
Range("N1:U" & WW).Select
Selection.Copy


Windows("Pedido.xls").Activate
Range("L1").Select
ActiveSheet.Paste


Columns("E:E").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
Workbooks("Pedido.xls").Close SaveChanges:=True


'Starting Notes Session
'__________________________________________________________________________________________
Find_and_Restore_Lotus_Notes_Window


Set NSession = CreateObject("Notes.NotesSession")
Set NUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
Set NDatabase = NSession.GetDatabase("", "")


If Not NDatabase.IsOpen Then
NDatabase.OPENMAIL
End If


'Create a new document
'__________________________________________________________________________________________
Set NDoc = NDatabase.CreateDocument


With NDoc
.SendTo = Range("A16").Value & ", " _
& Range("A17").Value & ", " _
& Range("A18").Value & ", " _
& Range("A19").Value & ", " _
& Range("A20").Value & ", " _
& Range("A21").Value & ", " _
& Range("A22").Value & ", " _
& Range("A23").Value & ", " _


.CopyTo = ""
.subject = "Base dados MSA & Balcão/SAS " & Now


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




.Body = "Bom dia, Programadores / Controladores." & vbNewLine & "* * * -------------------- A Base de dados do MSA, esta atualizado e pronta para uso. -------------------- * * *" _
& vbNewLine & vbNewLine & "Seguem as ordens Balcão e SAS, favor pedir pagamento:" & vbNewLine & "**1**" & vbNewLine & "**2**" & vbNewLine & vbNewLine & _
"Att, Lucas Fim Cabreira"


.Save True, False
End With


'Pasting Images into body
'__________________________________________________________________________________________
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture


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


.GotoField ("Body")
.FINDSTRING "**1**"


Dim LR As Integer
LR = Range("C" & Rows.Count).End(xlUp).row
Range("C1:L" & LR).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture


.Paste
Application.CutCopyMode = False


'--------------------------------------------


.GotoField ("Body")
.FINDSTRING "**2**"


Dim LW As Integer


LW = Range("N" & Rows.Count).End(xlUp).row
Range("N1:U" & LW).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture


.Paste
Application.CutCopyMode = False


'Attaching file
'__________________________________________________________________________________________
        If attachmentFile <> "" Then
            If Dir(attachmentFile) <> "" Then
                Set Attachment = .Document.CreateRichTextItem("Attachment")
                .InsertText String(2, vbLf) & "File attached: " & Mid(attachmentFile, InStrRev(attachmentFile, "\") + 1)
                Attachment.EMBEDOBJECT EMBED_ATTACHMENT, "", attachmentFile
            Else
                MsgBox "Arquivo" & attachmentFile & " Não encontrado, não foi adicionado em anexo."
            End If
        End If
'__________________________________________________________________________________________


.send
.Close
End With




Set NSession = Nothing
Range("A15").Select
Kill "I:\Areas\Planejamento\Controle\Rotinas\Pedido.xls"


 Application.DisplayAlerts = True
    Application.ScreenUpdating = True


End Sub

John_w · Oct 18, 2016

lu fim said:
It didnt work, shows me the window "sub or function not defined".

This is what you suggested?

Yes, that is correct as far as your own code is concerned. But the error indicates that you haven't included my code in post #2 in a new module in the same workbook.

.FINDSTRING Lotus Notes VBA

lu fim

New Member

Excel Facts

John_w

MrExcel MVP

lu fim

New Member

John_w

MrExcel MVP

lu fim

New Member

John_w

MrExcel MVP

lu fim

New Member

John_w

MrExcel MVP

Similar threads

Forum statistics

Share this page

.FINDSTRING Lotus Notes VBA

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock