Posts by prakash24

prakash24 · Jan 24th 2018

Hello Sir,
Hope you are doing Great, Sir what if I want to use worksheet(ws3) range (a1: t28) as a email body . how it can be done ?
Thank you

Code

[align=left][COLOR=#252C2F][FONT=Courier][SIZE=12px]Sub EmailByDateDue3()
  Dim ws As Worksheet, ws2 As Worksheet, r As Range, c As Range
  Dim f As Range, sig$, SentOnBehalfOfName$, body$, user$
  'Late binding
  Dim olApp As Object, olMail As Object, Word As Object, wr As Object


  'Early binding
  'Tools > References > Microsoft Outlook xx.0 Object Library
  'Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library
  'Dim Word As Document, wr As Word.Range


'****************** INPUTs ***************************************
  Set ws = Worksheets("Data")
  Set ws2 = Worksheets("Email sent Report")
set ws3 = worksheet ("body")
  'Signature file path, must exist.
  SentOnBehalfOfName = "[email protected]"
  sig = "C:\Users\PrakashPC\Desktop\New folder\Signature.rtf"
  user = Environ("username")
'****************** END INPUTs ***********************************
  If Dir(sig) = "" Then
    MsgBox sig, vbApplicationModal, "Macro Ending - File Does Not Exist"
    Exit Sub
  End If


  If user <> "PrakashPC" Or getUserName() <> "prakash" Then Exit Sub


  '100 day column
  Set r = ws.Range("G2", ws.Cells(Rows.Count, "G").End(xlUp))


  'Set olApp = New Outlook.Application  'Early binding
  'Set olApp = GetObject(, "Outlook.Application") 'Late binding
  Set olApp = CreateObject("Outlook.Application")


  For Each c In r
     If c < 95 Or c > 100 Then GoTo NextC 'Not due yet so skip.
    Set f = ws2.Columns("A").Find(ws.Cells(c.Row, "A"), ws2.[A1])
    If Not f Is Nothing Then GoTo NextC


    Set olMail = olApp.CreateItem(0)  'olMailItem=0
    With olMail
      .Importance = 1 'olImportanceNormal=1
      .To = ws.Cells(c.Row + 1, "e")
      .SentOnBehalfOfName = SentOnBehalfOfName
      .Subject = "100 Day Reminder"
      body = range.ws3("a1:t28").value


      .GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Set wr = Word.Content
      wr = body


      GetObject(sig).Content.Copy
      wr.Collapse Direction:=0  'wdCollapseEnd=0
      wr.Paste  'Paste at end


      '.DeferredDeliveryTime = Now + TimeValue("00:10:00")
      .Display
      '.Send


      'Write entry to log sheet.
      Set f = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      f = ws.Cells(c.Row, "A")  'Serial Number
      f.Offset(, 1) = ws.Cells(c.Row, "e") 'Name
      f.Offset(, 2) = ws.Cells(c.Row + 1, "e") 'Email
      f.Offset(, 3) = Date 'Reminder Sent
      f.Offset(, 3).NumberFormat = "dd/mm/yyyy"
      f.Offset(, 4) = ws.Cells(c.Row, "AS")
    End With
NextC:
  Next c


  On Error Resume Next
  Set olMail = Nothing
  Set olApp = Nothing
End Sub[/SIZE][/FONT][/COLOR][/align]
 [FONT=Courier]

Display More

[/FONT]

prakash24 · Dec 11th 2017

[SIZE=13px]

Quote from Kenneth Hobson

[/SIZE]

Hello sir,

I just got an error, Everything is working fine when outlook is open.

1) but at the time with closed outlook .. error of automation “disconnected from client “ error is coming when uncommenting (" “.send "” )with closed outlook.......//////

When (" '“ ‘.send is for only comment “") with outlook closed then its fine ...

and

2) sometimes also getting an error of outlook contact library.

Please assist. Thank you ..

prakash24 · Dec 10th 2017

[SIZE=13px]I just found my all workbooks right-clicked commands is freezed why ??? and how can I fix it ???[/SIZE]

prakash24 · Dec 10th 2017

how to Disable Alt-f11 "view code" and assign a different key to activate it ... .onkey Alt-f11 disable and when pressed "k" view code should appear. for only assigned workbook. Is it possible ???? To that Via Macro??

prakash24 · Dec 8th 2017

Perfect...Thank you, soo Much, sir ... ...

prakash24 · Dec 8th 2017

yes, your are right sir, Active X components error 429 is occurring in both codes. when outlook is closed, Sometimes error of Automation and Hidden Modules error in other PC's. Either its Getobject() or CreateObject().

prakash24 · Dec 6th 2017

Quote from Kenneth Hobson

Post the code or workbook so I can check.

Good morning sir,
Thank you for your frequent replies. Please find the attachment I changed the below line while getting the errors and few columns.

Set olApp = GetObject(, "Outlook.Application") 'Late binding

Set olApp = CreateObject("Outlook.Applicaiton") 'Late binding

and

one quick question sir ,

If i want the entry should write from row 5 of column A , then where i have to make changes ... i tried like this but it didn’t work for me .

Set f = ws2.Columns("A").Find(ws.Cells(c.Row, "A"), ws2.[A5])

Set f = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)

prakash24 · Dec 3rd 2017

Sir after running the code I just got this error. I changed ------

[SIZE=13px]Dim variable types to Object------Change Set lines-----change constant variables to their values.

I also Unchecked it from[/SIZE]

[SIZE=12px]Tools > References > Microsoft Outlook xx.0 Object Library
Tools > References > Microsoft Word xx.0 Object Library[/SIZE]

or Do I Have to keep it Checked in one system..

prakash24 · Dec 3rd 2017

Thank You sir, I will try this and get back to you tomorrow.

prakash24 · Dec 3rd 2017

Quote from Kenneth Hobson

Hello Sir,
Hope you are doing great , sir everything is working perfect but the only this is with the below code because as my file is in network drive and every computer has different version of outlook sometime getting error in some computers , Compile error in hidden module .
is it possible to remove outlook version limitations??? and also do I have to do tools>reference>object library for every computer???

Thank you

Code

Sub EmailByDateDue2()
  Dim ws As Worksheet, ws2 As Worksheet, r As Range, c As Range
  Dim u$, d$
  Dim f As Range, sig$, SentOnBehalfOfName$, body$, user$
  'Tools > References > Microsoft Outlook xx.0 Object Library
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library
  Dim Word As Document, wr As Word.Range

prakash24 · Dec 2nd 2017

[SIZE=13px]I am getting Run-time error 91 at gRibbonUI.Invalidate. while running Macro[/SIZE]

Code

Option Explicit


Public gSheetmenusEnabled As Boolean
Public gRibbonUI As IRibbonUI
Public Sub EnableSheetMenus()


    gSheetmenusEnabled = True
    gRibbonUI.Invalidate


End Sub
Public Sub DisableSheetMenus()


    gSheetmenusEnabled = False
    gRibbonUI.Invalidate


End Sub


Public Sub rbx_getEnabled(control As IRibbonControl, ByRef returnedVal)
'
' Code for getEnabled callback. Ribbon control command
'
    returnedVal = gSheetmenusEnabled
End Sub
Public Sub rbx_onLoad(ribbon As IRibbonUI)
'
' Code for onLoad callback. Ribbon control customUI
'
    Set gRibbonUI = ribbon


End Sub

Display More

prakash24 · Nov 30th 2017

Thank you sir , its working amazing ...and you are really a Great Person and a Great Teacher .

prakash24 · Nov 29th 2017

Yes, and its not even allowing me to run macro. showing

[SIZE=13px]Run-time error 462 said the remote server machine doesn't exist or unavailable[/SIZE]

prakash24 · Nov 29th 2017

sir after f8 on each line ..its showing at this place , Run-time error 462 said the remote server machine doesn't exist or unavailable . Even my outlook is also open

Code

.GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Set wr = Word.Content
      wr = body

prakash24 · Nov 29th 2017

Thank you sir ,
I just got these error . is it because of outlook ????

prakash24 · Nov 29th 2017

Thank you so much sir ,its Working amazing now everything is Working perfect just want to know few things

1) How unique number are working to stop the macro for sending it twice to same email.?

2) after sending email ,if we later increase the number of days left mean changes in start and end date , we Also first have to remove the entry from log sheet ? Is there any way that the full log sheet get clear by itself in every 2 month or 3 months on selected day.

3) If I want to CC one or more people ,how can I do it ?

4) sir as we have user as PrakashPC can we also add excel user there because to login in workbook i have different excel id/username?

prakash24 · Nov 28th 2017

Sir, I added two extra Column in my Log sheet for unique number =row() and formula countif,. Please have a look.

Sir, we always Change the master data with New start and End date , and sometime we also change name and email Address , to give a person the new time frame every time for each serial number to finish things ontime and we remind them by email when only 100 days left.

prakash24 · Nov 28th 2017

Really Thank you sir now its working perfectly ,

[SIZE=13px]the email are going as I wanted [/SIZE]

, but the only missing thing is As I call the macro in open workbook , every time I open the workbook its sending the email again or twice to the same serial number which is already been sent before.

Sir to control it you already gave a solution
"[SIZE=13px]You need the log sheet to have a unique number to make sure that it does not resend the next time is ran. I used serial number. If you don't do something like that, then you need a helper column to mark that shows email was sent." but how I can implement it so that it should not go twice to the same Serial number" .[/SIZE]

[SIZE=13px]How Can I Add a helper column or unique numbers?

Please Assist.[/SIZE]

prakash24 · Nov 28th 2017

Hello sir ,
Now the maco is started to work Just tested and recived 1st email with signature without any error in code but there is few thing happening here..

1) Macro is trying to send email to All serial numbers whether its day reached to 100 or below "all" and keeping the outllook open for all emails after sendings also. Can we put the range 95days to 100 day only .
2) Sometime when macro is running for all serial number , its skipping between Email Id and contact number "somtime taking Email Id and somtime taking contact number at reciepent"

Thankyou sir for the Code .

Code

Sub EmailByDateDue()
  Dim ws As Worksheet, ws2 As Worksheet, r As Range, c As Range
  Dim u$, d$
  Dim f As Range, sig$, SentOnBehalfOfName$, body$, user$
  'Tools > References > Microsoft Outlook xx.0 Object Library
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library
  Dim Word As Document, wr As Word.Range


'****************** INPUTs ***************************************
  Set ws = Worksheets("Data")
  Set ws2 = Worksheets("Email sent Report")
  'Signature file path, must exist.
  SentOnBehalfOfName = "[email protected]"
  sig = "C:\Users\PrakashPC\Desktop\New folder\Signature.rtf"
  u = Environ("username")
  d = Environ("computername")


  MsgBox u, vbInformation, "username"
  Debug.Print u, "username"
  MsgBox d, vbInformation, "computername"
  Debug.Print d, "computername"


  MsgBox u = "lenovo1"


  user = Environ("username")
'****************** END INPUTs ***********************************


  If user <> "PrakashPC" Then Exit Sub
  If Dir("C:\Users\PrakashPC\Desktop\New folder\Signature.rtf") = "" Then
  MsgBox "Sig file does not exist, macro ending.", vbCritical, sig
  Exit Sub
End If


  '100 day column
  Set r = ws.Range("G2", ws.Cells(Rows.Count, "G").End(xlUp))


  Set olApp = New Outlook.Application


  For Each c In r
    If c > 100 Then GoTo NextC  'Not due yet so skip.
    Set f = ws2.Columns("A").Find(ws.Cells(c.Row, "A"), ws2.[A1])
    If ws.Cells(c.Row + 1, "C") = "" Then GoTo NextC '.To value is missing, skip sending it.


    Set olMail = olApp.CreateItem(olMailItem)
    With olMail
      .Importance = olImportanceNormal
      .To = ws.Cells(c.Row + 1, "C")
      .SentOnBehalfOfName = SentOnBehalfOfName
      .Subject = "100 Day Reminder"
      body = "Name: " & ws.Cells(c.Row, "C") & vbCrLf
      body = body & "Amount: " & ws.Cells(c.Row, "D") & vbCrLf
      body = body & "Serial No.: " & ws.Cells(c.Row, "A")


      .GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Set wr = Word.Content
      wr = body


      GetObject("C:\Users\PrakashPC\Desktop\New folder\Signature.rtf").Content.Copy
      wr.Collapse Direction:=wdCollapseEnd
      wr.Paste  'Paste at end
      '.Send


      'https://msdn.microsoft.com/en-us/library/microsoft.office.interop.outlook._mailitem.deferreddeliverytime.aspx?cs-save-lang=1&cs-lang=vb#code-snippet-1
      .DeferredDeliveryTime = Now + TimeValue("00:10:00")
      .Display
      '.Send


      'Write entry to log sheet.
      Set f = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      f = ws.Cells(c.Row, "A")  'Serial Number
      f.Offset(, 1) = ws.Cells(c.Row, "C") 'Name
      f.Offset(, 2) = ws.Cells(c.Row + 1, "C") 'Email
      f.Offset(, 3) = Date 'Reminder Sent
      f.Offset(, 3).NumberFormat = "mm/dd/yyyy"
    End With
NextC:
  Next c


  On Error Resume Next
  Set olMail = Nothing
  Set olApp = Nothing
End Sub

Display More

prakash24 · Nov 27th 2017

Quote from Kenneth Hobson

Good Morning Sir, Wish You a Wonderful Day.
Sir I tried to insert the code but still getting the same error.. Please check.

Code

Sub EmailByDateDue()
  Dim ws As Worksheet, ws2 As Worksheet, r As Range, c As Range
  Dim u$, d$
  Dim f As Range, sig$, SentOnBehalfOfName$, body$, user$
  'Tools > References > Microsoft Outlook xx.0 Object Library
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library
  Dim Word As Document, wr As Word.Range


'****************** INPUTs ***************************************
  Set ws = Worksheets("Data")
  Set ws2 = Worksheets("Email sent Report")
  'Signature file path, must exist.
  SentOnBehalfOfName = "[email protected]"
  sig = ThisWorkbook.Path & "C:\Users\PrakashPC\AppData\Roaming\Microsoft\Signatures\Signature.rtf"
  u = Environ("username")
  d = Environ("computername")


  MsgBox u, vbInformation, "username"
  Debug.Print u, "username"
  MsgBox d, vbInformation, "computername"
  Debug.Print d, "computername"


  MsgBox u = "lenovo1"


  user = Environ("username")
'****************** END INPUTs ***********************************


  If user <> "Prakash" Then Exit Sub
  If Dir(sig) = "" Then
  MsgBox "Sig file does not exist, macro ending.", vbCritical, sig
  Exit Sub
End If


  '100 day column
  Set r = ws.Range("G2", ws.Cells(Rows.Count, "G").End(xlUp))


  Set olApp = New Outlook.Application


  For Each c In r
    If c > 100 Then GoTo NextC  'Not due yet so skip.
    Set f = ws2.Columns("A").Find(ws.Cells(c.Row, "A"), ws2.[A1])
    If ws.Cells(c.Row + 1, "C") = "" Then GoTo NextC '.To value is missing, skip sending it.


    Set olMail = olApp.CreateItem(olMailItem)
    With olMail
      .Importance = olImportanceNormal
      .To = ws.Cells(c.Row + 1, "C")
      .SentOnBehalfOfName = SentOnBehalfOfName
      .Subject = "100 Day Reminder"
      body = "Name: " & ws.Cells(c.Row, "C") & vbCrLf
      body = body & "Amount: " & ws.Cells(c.Row, "D") & vbCrLf
      body = body & "Serial No.: " & ws.Cells(c.Row, "A")


      .GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Set wr = Word.Content
      wr = body


      GetObject(sig).Content.Copy
      wr.Collapse Direction:=wdCollapseEnd
      wr.Paste  'Paste at end


      'https://msdn.microsoft.com/en-us/library/microsoft.office.interop.outlook._mailitem.deferreddeliverytime.aspx?cs-save-lang=1&cs-lang=vb#code-snippet-1
      .DeferredDeliveryTime = Now + TimeValue("00:10:00")
      .Display
      '.Send


      'Write entry to log sheet.
      Set f = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      f = ws.Cells(c.Row, "A")  'Serial Number
      f.Offset(, 1) = ws.Cells(c.Row, "C") 'Name
      f.Offset(, 2) = ws.Cells(c.Row + 1, "C") 'Email
      f.Offset(, 3) = Date 'Reminder Sent
      f.Offset(, 3).NumberFormat = "mm/dd/yyyy"
    End With
NextC:
  Next c


  On Error Resume Next
  Set olMail = Nothing
  Set olApp = Nothing
End Sub

Display More

Posts by prakash24

Email based on Criteria ....

Email based on Criteria ....

fix command bars....

Assigning different key from keyboard .

Email based on Criteria ....

Email based on Criteria ....

Email based on Criteria ....

Email based on Criteria ....

Email based on Criteria ....

Email based on Criteria ....

Custom UI Ribbon Home tab

Email based on Criteria ....

Email based on Criteria ....

Email based on Criteria ....

Email based on Criteria ....

Email based on Criteria ....

Email based on Criteria ....

Email based on Criteria ....

Email based on Criteria ....

Email based on Criteria ....