Posts by eurano

Option Explicit
Sub GetFileNames()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "D:"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & ""
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & ""
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub

C:\Users\kuckam\AppData\Local\IBM\Notes\Data\mail\gdansk


Function GetNSF(ByRef strFileName As String) As Boolean
     
     
    On Error Resume Next
    strFileName = Dir(Environ("COMPUTERNAME") & "\Local\IBM\Notes\Data\Mail\gdansk\*.nsf")
     
    GetNSF = (strFileName <> vbNullString)
     
End Function


 Sub test()
     
     
    Dim strFileName As String
    If GetNSF(strFileName) Then
    Debug.Print strFileName
    End If
     
End Sub

Option Explicit
 
'Function for finding the first top level window in the windows list
'that meet the criteria.
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
      (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
 
Sub Send_Formatted_Range_Data()
   Dim oWorkSpace As Object, oUIDoc As Object
   Dim rnBody As Range
   Dim lnRetVal As Long
 
   Const stTo As String = "[email protected]"
   Const stCC As String = ""
   Const stBody As String = vbCrLf & " "
   Const stSubject As String = "Report xxx"
   Const stMsg As String = "An e-mail has been succesfully created and saved."
 
   'Check if Lotus Notes is open or not.
   lnRetVal = FindWindow("NOTES", vbNullString)
 
   If lnRetVal = 0 Then
      MsgBox "Please make sure that Lotus Notes is open!", vbExclamation
      Exit Sub
   End If
 
   Application.ScreenUpdating = False
 
   'A named range in the activesheet is in use.
   Set rnBody = ActiveSheet.Range("Report")
   rnBody.Copy
 
   'Instantiate the Lotus Notes COM's objects.
   Set oWorkSpace = CreateObject("Notes.NotesUIWorkspace")
 
   On Error Resume Next
   Set oUIDoc = oWorkSpace.ComposeDocument("", "mail\gdansk\[U][B]xxx.nsf[/B][/U]", "Memo")
   On Error GoTo 0
 
   Set oUIDoc = oWorkSpace.CurrentDocument
    'Using LotusScript to create the e-mail.
   Call oUIDoc.FieldSetText("EnterSendTo", stTo)
   Call oUIDoc.FieldSetText("EnterCopyTo", stCC)
   Call oUIDoc.FieldSetText("Subject", stSubject)


   'If You experience any issues with the above three lines then replace it with:
   'Call oUIDoc.FieldAppendText("EnterSendTo", stTo)
   'Call oUIDoc.FieldAppendText("EnterCopyTo", stCC)


   'Call oUIDoc.FieldAppendText("Subject", stSubject)
   
   'The can be used if You want to add a message into the created document.
   Call oUIDoc.FieldAppendText("Body", vbNewLine & stBody)
 
   'Here the selected range is pasted into the body of the outgoing e-mail.
   Call oUIDoc.GotoField("Body")
   Call oUIDoc.Paste
    Set oUIDoc = oWorkSpace.CurrentDocument
    Call oUIDoc.GotoField("Body")
    Call oUIDoc.InsertText("Proszę zorganizować wizytę serwisu w celu  dokonania przeglądów wózków:")  'calls a function to return the body  contents.
   'Save the created document.
   Call oUIDoc.Save(True, False, False)
   Call oUIDoc.Send(True)
 
   'Release objects from memory.
   Set oWorkSpace = Nothing
   Set oUIDoc = Nothing
 
   With Application
      .CutCopyMode = False
      .ScreenUpdating = True
   End With
 
   MsgBox stMsg, vbInformation
 
   'Activate Lotus Notes.
   AppActivate ("Notes")
 
End Sub