How to send each file in folder through outlook with conditional, ID, Subject & Body with Signature?

Kenneth Hobson · Oct 27, 2017

I'll have to think about post #25. It would be more simple if you just made a list of unique group names. You can export addresses from Outlook. You could then manage it.

I guess an On Error could gracefully skip missing group names. Recipients.ResolveAll might help but might show more issues if one email in the group is invalid.

So, decide how you want to handle, Outlook Missing Group Name (pf). (a) Skip without notice, (b) MsgBox notification and skip, (c) don't Send, Display, (d) etc.

It should be easy to test how a Send works if duplicate Outlook Group Names exist. I find it surprising that Outlook even allows that. Microsoft normally watches out for the user closely.

Ok, now for the main course. It was just a few tweaks to change the order of the WordEditor body. Change the final built "S" strings to suit.

Code:

Sub Main()
  Dim T$, p$, a, e, r As Range, c As Range, pF$, S$, sig$
  Dim fso As Object, wb As Workbook, ws As Worksheet
  'Tools > References > Microsoft Outlook xx.0 Object Library > OK
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library > OK
  Dim Word As Document, wr As Word.Range

  'INPUTS to change if needed...........................................................
  T = "ken@gmail.com"
  'p = "H:\WINT-17\1-W-17-ALL ORIGINAL FROM MILL\W-17-CONFIRMATION\*.*"
  p = "C:\Users\lenovo1\Dropbox\Excel\Outlook\emailPDFinvoices\*.*"
  Set wb = Workbooks.Open(ThisWorkbook.Path & "\SUITING-BUYER MASTER.xlsx", False, True)
  Set ws = wb.Worksheets("BUY MASTER")
  'File to copy content as signature for body of email.
  sig = ThisWorkbook.Path & "\sig.rtf"
  'End INPUTS...........................................................................

  Set fso = CreateObject("Scripting.FileSystemObject")

  'Batch to get all filenames.
  a = aFFs(p)
  If Not IsArray(a) Then Exit Sub

  'Get Outlook application
  Set olApp = New Outlook.Application

  'Iterate all elements in a, filenames to attach.
  For Each e In a
    'Get 5-digit prefix of base filename.
    pF = fso.GetBaseName(e)
    If Len(pF) < 5 Then GoTo NextE
    pF = Left(pF, 5)
  
    'Find matching prefix "number" in usedrange G:H
    Set r = ws.Range("G1:H" & ws.Cells(ws.Rows.Count, "G").End(xlUp).Row).Find _
      (Val(pF), ws.[G1], , xlWhole)
    If r Is Nothing Then GoTo NextE
  
    'Set subject value:
    S = pF & "-" & ws.Cells(r.Row, "I").Value & ", (" & ws.Cells(r.Row, "J").Value & ")"
  
    'Copy content from sig.rtf as signature for body of email to clipboard.
    GetObject(sig).Range.Copy
  
    'Make email, attach file, and  send/display.
    'Set olMail = olApp.CreateItem(olMailItem)
    With olApp.CreateItem(olMailItem)
      .Importance = olImportanceNormal
      .To = pF  'T
      .Subject = S
      
      'Add copy of sig.rtf to body.
      .GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Set wr = Word.Content
      wr.Collapse Direction:=wdCollapseEnd
      wr.Paste
    
      'Add body text after sig.rtf.
        'Build string for body.
      S = S & "," & vbCrLf & vbCrLf & _
        "Your Confirmation Attached" & vbCrLf & vbCrLf & _
        "Regards," & vbCrLf & "My name," & vbCrLf & _
        "Firm name, & Contact detail.."
      'set up for adding S at end.
      wr.Collapse Direction:=wdCollapseEnd
      wr = S

      .Attachments.Add e
      '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
    End With
NextE:
  Next e

TheEnd:
  Set olMail = Nothing
  Set olApp = Nothing
  Set ws = Nothing
  wb.Close False
  Set wb = Nothing
End Sub

Chirag R Raval · Oct 27, 2017

Dear Sir @Kenneth Hobson ,

Before I test your updated above macro
I want to bring notice of you that actually there are
2 contacs record file in outlook (1)contacts (2) Suggested contacts
I may be for precaution or any other fear factor from subconsiously about not want to loss any data from both record files
So I always try to maintain same number of contact records with all details same
In both record files. So I always copy one contacts records in another.

If I make any one default for contact provider/Source either "Contact" or
"Suggested Contact ", & may be outlook presents group or contacts from only one
Record file may resolve this matter because any one file should not have any chance to create duplicate record. as per
Universal machine rule that same file name can not create in same folder..& also as per your comment here,
I actually not try yet to make Same contact group name in same contact file..
But this is fact that when I send mail through this code, mostly its display same group name in list 4 time repeated..

I try to discontinue service from any one contact record file..but with doubt & fear that I can not maintain both file as have same number of records & same detail because I also not more know that where are importantly links with other factors of this contact s in machine.

For your point on if group name not found or missing group name , then of course option (b) Msgbox with file name & skip ...because there are options available there to note down missing group & resume next .. after code coplete its process. We can check either mistake in file name or reallly not created group for that file its also usefull for future/preventions / precautions from skipping ....

Again many thanks for your valuable effort for this thread with your valuable knowledge .

I write this post now through phone so i will revert after check on Pc.

Regards,
Chirag Raval

Chirag R Raval · Oct 28, 2017

Dear Sir,

I used your below code with some modify.

Code:

'https://www.chandoo.org/forum/threads/how-to-send-each-file-in-folder-through-outlook-with-conditional-id-subject-body-with-signature.36140/#post-217008
'WARNING-AS PER BELOW, Function aFFs REQUIRE TO RUN THIS MACRO
Sub Outlook_Mal_AttmusigltKenn2()
  Dim T As String
  Dim p As String
  Dim a As Variant
  Dim e As Variant
  Dim r As range
  Dim c As range
  Dim pF As String
  Dim S As String
  Dim sig As String
  Dim fso As Object
  Dim wb As Workbook
  Dim Ws As Worksheet


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

  'INPUTS to change if needed...........................................................
  T = "ken@gmail.com"
  'p = "H:\WINT-17\1-W-17-ALL ORIGINAL FROM MILL\W-17-CONFIRMATION\*.*"
  p = "D:\SUITING  W-17 CONFIRMATION SEND TO TRS\*.xlsx"
'  Set wb = Workbooks.Open(ThisWorkbook.Path & "\SUITING-BUYER MASTER.xlsx", False, True)
  Set wb = Workbooks.Open("C:\BUYER MASTER\SUITING-BUYER MASTER.xlsx", False, True)
  'Windows(wb.Name).Visible = False
  Set Ws = wb.Worksheets("BUY MASTER")
  'File to copy content as signature for body of email.
  sig = "C:\Users\sganuja\AppData\Roaming\Microsoft\Signatures\CHIRAG2.rtf"
  'End INPUTS...........................................................................
    Set fso = CreateObject("Scripting.FileSystemObject")
    'Batch to get all filenames.
  a = aFFs(p)
  If Not IsArray(a) Then Exit Sub
    'Get Outlook application
  Set olApp = New Outlook.Application

  'Iterate all elements in a, filenames to attach.
  For Each e In a
    'Get 5-digit prefix of base filename.
    pF = fso.GetBaseName(e)
    If Len(pF) < 5 Then GoTo NextE
    pF = Left(pF, 5)
  
    'Find matching prefix "number" in usedrange G:H
    Set r = Ws.range("G1:H" & Ws.Cells(Ws.Rows.count, "G").End(xlUp).Row).Find _
      (Val(pF), Ws.[G1], , xlWhole)
    If r Is Nothing Then GoTo NextE
  
    'Set subject value:
    S = pF & "-" & "M/s. " & Ws.Cells(r.Row, "I").Value & ", (" & Ws.Cells(r.Row, "J").Value & ")" & " YOUR SUITING WINT-17 CONFIRMATION ATTACHED"
  
    'Copy content from sig.rtf as signature for body of email to clipboard.
    GetObject(sig).range.Copy
  
    'Make email, attach file, and  send/display.
    'Set olMail = olApp.CreateItem(olMailItem)
    With olApp.CreateItem(olMailItem)
      .Importance = olImportanceNormal
      .To = pF
      .Subject = S
      
      'Add 1st part of body.
      .GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Word.Content = "Dear Sir," & vbCrLf & vbCrLf & S & "," & vbCrLf & vbCrLf & _
          vbCrLf & vbCrLf
                        
      'Paste signature at end of body.
      Set wr = Word.Content
      wr.Collapse Direction:=wdCollapseEnd
      wr.Paste  'Paste at end
    
      Application.SendKeys ("^{home}")

      .Attachments.add e
      '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")'IF YOU WANT TO SEND AFTER 10 MINUTS
'      .Display 'NOT SEND -JUST DISPLAYED-REMOVE COMMENT IF YOU WANT WANT JUST DISPLAY
    .Send ' FOR SENDING MAIL, REMOVE COMMENT IF YOU WANT SEND
    End With
NextE:
  Next e

TheEnd:
  Set olMail = Nothing
  Set olApp = Nothing
  Set Ws = Nothing
  wb.Close False
  Set wb = Nothing
End Sub

Sub EmbedClipboardAndAppendClipboardInBody()
  Dim Ws As Worksheet, r As range, b As range
  '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

  Set Ws = Worksheets("Renewal Dates")
  Set r = Ws.range("A1:H1")

  Set olApp = New Outlook.Application
  Set olMail = olApp.CreateItem(olMailItem)

  r.AutoFilter 7, ">=" & Date
  r.AutoFilter 8, "<>x"
  Exit Sub

  With olMail
    .Importance = olImportanceNormal
    .To = "ken"
    .Subject = "31 Day Reminder"
    
    .GetInspector.Display
    Set Word = .GetInspector.WordEditor
  
    r.Copy
    Word.range(0, 0).Paste
    r.offset(2).Copy
    Set wr = Word.Content
    wr.Collapse Direction:=wdCollapseEnd
    wr.Paste  'Paste at end
    Application.CutCopyMode = False
  
    '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 'NOT SEND -JUST DISPLAYED-REMOVE COMMENT IF YOU WANT WANT JUST DISPLAY
    .Send ' FOR SENDING MAIL, REMOVE COMMENT IF YOU WANT SEND
  End With

TheEnd:
  Set olMail = Nothing
  Set olApp = Nothing
End Sub

'Set extraSwitches, e.g. "/ad", to search folders only.
'MyDir should end in a "\" character unless searching by wildcards, e.g. "x:\test\t*
'Command line switches for the shell's Dir, http://ss64.com/nt/dir.html
Function aFFs(myDir As String, Optional extraSwitches = "", _
  Optional tfSubFolders As Boolean = False) As Variant

  Dim S As String, a() As String, v As Variant
  Dim b() As Variant, i As Long

  If tfSubFolders Then
    S = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
      """" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
    Else
    S = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
      """" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
  End If

  a() = Split(S, vbCrLf)
  If UBound(a) = -1 Then
    Debug.Print myDir & " not found.", vbCritical, "Macro Ending"
    Exit Function
  End If
  ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr

  For i = 0 To UBound(a)
    If Not tfSubFolders Then
      S = Left$(myDir, InStrRev(myDir, "\"))
      'add the folder name
      a(i) = S & a(i)
    End If
  Next i
  aFFs = sA1dtovA1d(a)
End Function

just require line break or paragraph break

15913-M/s. SHREE HIND (TRS), (JAMKHAMBHALIA) --break from here
YOUR SUITING WINT-17 CONFIRMATION ATTACHED,

OR

Please modify your code in your post no 26 for get above result

Regards,
Chirag Raval

Kenneth Hobson · Oct 28, 2017

You lost me in all that. As I explained before, it should be readily seen how to setup the body of your email in any order that you want.

In this one, I showed you how to resolve the email address which is a group name. Either it exists or not. If not, it shows the Msgbox that you wanted and puts a note into the Immediate Window (ctrl+G). That way, if you want to skip the MsgBox, you can still get a list after the Run of what did not Send and Send will not fail. Display is just for testing.

IF it were me, I would put the Sent files into an Archive folder as part of the macro. The ones left after a run would mean a Run was not made since they were created or the prefix does not exist as a Group Name in your Outlook addressbook.

What happens for duplicate Group Names, I don't know. You can readily test yourself. I suspect it as I explained earlier, it picks the 1st or default one. I can show you simple code to test that.

As for the duplicates, I don't see how that would happen. Check that the attached filename ties in with the string S. It should but I only tested with 2 files. My guess is that you have filenames with prefixs the same. As I think you meant, a duplicate filename in the same folder is impossible. It is not impossible to have the same prefix for many files.

As before, change the body parts to suit.

Code:

Sub Main()
  Dim T$, p$, a, e, r As Range, c As Range, pF$, S$, sig$
  Dim fso As Object, wb As Workbook, ws As Worksheet
  'Tools > References > Microsoft Outlook xx.0 Object Library > OK
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library > OK
  Dim Word As Document, wr As Word.Range, rTo As Recipient

  'INPUTS to change if needed...........................................................
  T = "ken@gmail.com"
  'p = "H:\WINT-17\1-W-17-ALL ORIGINAL FROM MILL\W-17-CONFIRMATION\*.*"
  p = "C:\Users\lenovo1\Dropbox\Excel\Outlook\emailPDFinvoices\*.*"
  Set wb = Workbooks.Open(ThisWorkbook.Path & "\SUITING-BUYER MASTER.xlsx", False, True)
  Set ws = wb.Worksheets("BUY MASTER")
  'File to copy content as signature for body of email.
  sig = ThisWorkbook.Path & "\sig.rtf"
  'End INPUTS...........................................................................

  Set fso = CreateObject("Scripting.FileSystemObject")

  'Batch to get all filenames.
  a = aFFs(p)
  If Not IsArray(a) Then Exit Sub

  'Get Outlook application
  Set olApp = New Outlook.Application

  'Iterate all elements in a, filenames to attach.
  For Each e In a
    'Get 5-digit prefix of base filename.
    pF = fso.GetBaseName(e)
    If Len(pF) < 5 Then GoTo NextE
    pF = Left(pF, 5)

    'Find matching prefix "number" in usedrange G:H
    Set r = ws.Range("G1:H" & ws.Cells(ws.Rows.Count, "G").End(xlUp).Row).Find _
      (Val(pF), ws.[G1], , xlWhole)
    If r Is Nothing Then GoTo NextE

    'Set subject value:
    S = pF & "-" & ws.Cells(r.Row, "I").Value & ", (" & ws.Cells(r.Row, "J").Value & ")"

    'Copy content from sig.rtf as signature for body of email to clipboard.
    GetObject(sig).Range.Copy

    'Make email, attach file, and  send/display.
    'Set olMail = olApp.CreateItem(olMailItem)
    With olApp.CreateItem(olMailItem)
      .Subject = S
      .Importance = olImportanceNormal
  
      Set rTo = .Recipients.Add(pF)
      rTo.Resolve
      rTo.Type = olTo 'olcc, olbcc
      If rTo.Resolved = False Then
        Debug.Print pF, "Resolved=False"
        MsgBox pF & " email group does not exist." & _
          "Notice placed in VBE's Immediate Window.", _
          vbInformation, "Skipped Sending" & pF & " Group Email"
        GoTo NextE
      End If
      '.To = pF  'Using rTo for .To now.
    
      .GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Word.Content = "Dear Sir, " & vbCrLf & vbCrLf & S & _
        vbCrLf & vbCrLf & "Confirmation Attached" _
        & vbCrLf & vbCrLf & _
        "Regards," & vbCrLf & "My name," & vbCrLf & _
        "Firm name, & Contact detail.."
  
      'Paste sig.rtf
      Set wr = Word.Content
      wr.Collapse Direction:=wdCollapseEnd
      wr.Paste

      .Attachments.Add e
      .Display
      '.Send
    End With
NextE:
  Next e

TheEnd:
  Set olMail = Nothing
  Set olApp = Nothing
  Set ws = Nothing
  wb.Close False
  Set wb = Nothing
End Sub

Chirag R Raval · Oct 28, 2017

Dear Sir @Kenneth Hobson ,

Many thanks for your effort..
I will revert soon .

Regards,

Chirag Raval

Chirag R Raval · Oct 29, 2017

Dear Sir @kenneth hobson ,

Amzing, Perfact As desired, work like a miracle.

thank you very much for your valuable effort & help..

Mainly for word editor, where we can easly edit message body as required,
i just commented all body text from "regards", & all done perfactly
my sig.rtf present below all things thats i want.

Also many thanks for added coded for checks for "not sended mails". & inform as message box & also in immedaite window.

You are right ..if mails which sucessfully resolved (sended) & if files attached for that mail, moved in other folder, then in main folder of files remains only unsucess files which can not send due to either problem in group name, or e-mail id in group name, or either, mistake in file name,
so if after clear all matter regarding error in sending, we can re-run this macro for only those which not sended at previous attemts , so this way we can outcome or precautions from multi time sending same all mails on re-run targeted for only not sended files..

Hope, you also will embeded little code for this process in your code.

Regards,

Chirag Raval

Kenneth Hobson · Oct 29, 2017

Be sure to add the Archive folder or change the path. I did not address possible duplicates already moved to the Archive folder. I just skipped the move.

Code:

Sub Main()
  Dim T$, p$, a, e, r As Range, c As Range, pF$, S$, sig$, af$, afn$
  'Tools > References > Microsoft Scripting Runtime
  'Dim fso As New FileSystemObject
  Dim fso As Object
  Dim wb As Workbook, ws As Worksheet
  'Tools > References > Microsoft Outlook xx.0 Object Library > OK
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library > OK
  Dim Word As Document, wr As Word.Range, rTo As Recipient

  'INPUTS to change if needed...........................................................
  T = "ken@gmail.com"
  'p = "H:\WINT-17\1-W-17-ALL ORIGINAL FROM MILL\W-17-CONFIRMATION\*.*"
  p = "C:\Users\lenovo1\Dropbox\Excel\Outlook\emailPDFinvoices\*.*"
  Set wb = Workbooks.Open(ThisWorkbook.Path & "\SUITING-BUYER MASTER.xlsx", False, True)
  Set ws = wb.Worksheets("BUY MASTER")
  'File to copy content as signature for body of email.
  sig = ThisWorkbook.Path & "\sig.rtf"
  af = ThisWorkbook.Path & "\Archive\" 'Folder to move files to after attach and Send.
  'End INPUTS...........................................................................

  Set fso = CreateObject("Scripting.FileSystemObject")

  'Batch to get all filenames.
  a = aFFs(p)
  If Not IsArray(a) Then Exit Sub

  'Get Outlook application
  Set olApp = New Outlook.Application

  'Iterate all elements in a, filenames to attach.
  For Each e In a
    'Get 5-digit prefix of base filename.
    pF = fso.GetBaseName(e)
    If Len(pF) < 5 Then GoTo NextE
    pF = Left(pF, 5)
  
    'Find matching prefix "number" in usedrange G:H
    Set r = ws.Range("G1:H" & ws.Cells(ws.Rows.Count, "G").End(xlUp).Row).Find _
      (Val(pF), ws.[G1], , xlWhole)
    If r Is Nothing Then GoTo NextE
  
    'Set subject value:
    S = pF & "-" & ws.Cells(r.Row, "I").Value & ", (" & ws.Cells(r.Row, "J").Value & ")"
  
    'Copy content from sig.rtf as signature for body of email to clipboard.
    GetObject(sig).Range.Copy
  
    'Make email, attach file, and  send/display.
    'Set olMail = olApp.CreateItem(olMailItem)
    With olApp.CreateItem(olMailItem)
      .Subject = S
      .Importance = olImportanceNormal
    
      Set rTo = .Recipients.Add(pF)
      rTo.Resolve
      rTo.Type = olTo 'olcc, olbcc
      If rTo.Resolved = False Then
        Debug.Print pF, "Resolved=False"
        MsgBox pF & " email group does not exist." & _
          "Notice placed in VBE's Immediate Window.", _
          vbInformation, "Skipped Sending" & pF & " Group Email"
        GoTo NextE
      End If
      '.To = pF  'Using rTo for .To now.
      
      .GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Word.Content = "Dear Sir, " & vbCrLf & vbCrLf & S & _
        vbCrLf & vbCrLf & "Confirmation Attached" _
        & vbCrLf & vbCrLf & _
        "Regards," & vbCrLf & "My name," & vbCrLf & _
        "Firm name, & Contact detail.."
    
      'Paste sig.rtf
      Set wr = Word.Content
      wr.Collapse Direction:=wdCollapseEnd
      wr.Paste

      .Attachments.Add e
      .Display
      '.Send
    End With
    With fso
      afn = af & .GetFileName(CStr(e))
      If Not .FileExists(afn) And .FolderExists(af) Then _
        .MoveFile CStr(e), afn
    End With
NextE:
  Next e

TheEnd:
  Set olMail = Nothing
  Set olApp = Nothing
  Set ws = Nothing
  wb.Close False
  Set wb = Nothing
End Sub

Chirag R Raval · Oct 29, 2017

Dear SIr @Kenneth Hobson ,

Yes...You really make my day...Its Powerfull, Amazing, Super Fast & all done as desired...lke Miracle..Thank You Very Much Sir..

Really this thread make an Example of "How To Send Alll Files Of Pertcular Folder To Each Unique Recipients With Unique File Realted Subject & Unique Related Message Body With Sent Or Not Varification"

This thread meet with all its required solutions now.
Hope its become very helpfull to millions of users on this glob who search for
this type of requirement..

Again thanks for all Experts , Helping Users & also This Website who support & help for problems of users with huge knowledgeable guideline & motivations.

Regards,

Chirag Raval

Chirag R Raval · Jun 1, 2018

Dear Sir @Kenneth Hobson ,

Through this code, I can not send mail in Cc. & Bcc. (Id as outlook group)

How to add Cc. & Bcc. in code?
How to add "group id" in cc: & bcc ?

if, Cc & Bcc group id not found, then mail must to send first as "To",

but there are message should display that ...

if problem in CC group id then ....
"Cc - can not send due to their group id not resolved.

if problem in Bcc group id then...
"Bcc - can not send due to their group id not resolved.

Please help.

Regards,

Chirag Raval

Kenneth Hobson · Jun 1, 2018

I am not sure what you mean by Group ID. Alias values for the Group works for TO, CC, and BCC.

The CC and BCC resolve in the same way as the TO resolve did. Just takes a bit more coding to add that and the MsgBox() as you have in the previous code.

Rather than doing all that, you might consider running a separate code prior to this code in this thread to delete, move, or markup the Alias values in say a range of cells that do not exist for the user running that code. This would be a good topic to move to a separate thread as this one dealt with several issues.

Chirag R Raval · Jun 3, 2018

Dear Sir @Kenneth Hobson,

Thank you very much for your kind suggestions.

I added Cc., Bcc. As per your construct in your helping code.
& It's working well though till now , not face any error
Due to it resolved Cc & Bcc in outlook,

Yes you are right, I will post this topic as another thread.

Regards,

Church Raval

Chirag R Raval · Mar 6, 2020

Dear Sir @Kenneth Hobson ,

After Long time....your suppppper code work like a charm till now...but.... why below error shown now?
i copy your code for many different situation they all work super till now... but...since yesterday...

which line cause error???

Attached your invaluable code..

Hope you can help me sir...

Regards,

Chirag Raval

vletm · Mar 6, 2020

Chirag R Raval
Is there extra space after (sig)?

... or at least GetObject(sig) .range.Copy should look like GetObject(sig).Range.Copy
after You've moved to next line.

Chirag R Raval · Mar 7, 2020

Dear Sir @vletm ,

Thanks for your response.i checked there are no space extra space after (sig). I also already try to copy paste your given "should look like GetObject(sig).Range.Copy ...i also check whole path till that signature fle ..but seems its not recognize that file....since last 3 days that error force me to must do manual work....

anything can you guess? what may be cause this? or signature file (chirag.rtf) must should be open?
if it require to open ,that why it work till now without open it?

or as per this link can i process?

Excel VBA CreateObject: Run-time error '432': File name or class not found during Automation operation

How do I fix the error "Run-time error '432': File name or class not found during Automation operation" I get when calling "CreateObject("Scripting.FileSystemObject")" in Excel VBA? I have a sprea...

stackoverflow.com

Hope some way found...

Regards,

Chirag Raval

vletm · Mar 7, 2020

Chirag R Raval
If You send snapshots form something then those should be same as in Your thread.
... below .range ... shows that line is not written correct for some reason. No need to use any copy&paste tricks!

Is that file in correct folder?
'Copy content from sig.rtf as signature for body of email to clipboard.

Have You updated or changed Your Excel-version? ... are all settings same as few days ago?
Have You changed ... anything ... in that code in previous days? ... anything means anything!
Have You tried with backup?

Chirag R Raval · Mar 7, 2020

Dear Sir @vletm ,

i install

& uninstall python , also uninstall pycharm (python editor), also run ccleaner can it effect those?
can i repair office 2016 now if that can resolve this issue?

Regards,
Chirag Raval

Chirag R Raval · Mar 12, 2020

Dear Sir @vletm & Sir @Kenneth Hobson ,

Can we resolve it? what need to check ? if something happen in registry? or other aspects?

Regards,
Chirag Raval

vletm · Mar 12, 2020

Chirag R Raval
From my side
... I gave some things to check ... but ... seems that You skipped those.
... I cannot test that at all!
>> You should learn to wait, until Hobson will answer for You <<

Chirag R Raval · Mar 14, 2020

Dear Sir @vletm , & Sir @Kenneth Hobson

Have You updated or changed Your Excel-version? ... No
are all settings same as few days ago?-Yes
Have You changed ... anything ... in that code in previous days? ... anything means anything!-no just instal apache open office & Access Database engine
Have You tried with backup?" Yes i create separate file with .Xlsm extension there are only 1 this code ..but same error...also there..

i also test scrrul.dll through free application "dependency walker" at this site http://www.dependencywalker.com/file

but i can not understand this red lines...to which errors it pointing ..? which error i can resolve ?

May be my antivirus block that path or file?
why that file (chirag.rtf) not found by vba editor ?..there though it it still there...!!!

what is about class name? which class it needed for GetObject method?

Please help..

Regards,

Chirag Raval

vletm · Mar 14, 2020

Chirag R Raval
Have You updated or changed Your Excel-version? ... No ... Okay, same version.
are all settings same as few days ago?-Yes ... later, You wrote that You have installed something ...
Have You changed ... anything ... in that code in previous days? ... anything means anything!-no just instal apache open office & Access Database engine ... and You're 100% that those no effect to Excel?
If You have same Excel-version with same settings then it should work as before ... means ... something has changed ... with settings!
Have You tried with backup?" Yes i create separate file with .Xlsm extension there are only 1 this code ..but same error...also there..
... as You above wrote ... You did NOT tried with a backup! You created something new and tested with that - that's different!
Can You test backup or the real file with other computer, which 'works as normal as those would'?
You continued testing with '...Walker...'. Is Your Windows any of those versions, which there has named?
Have You verified that sig's values is correct?
Have You checked - What settings GetObject needs?

Chirag R Raval · Mar 16, 2020

Dear SIr @vletm ,

I also check & reset-file association to open .rtf files -that seems always associate with.docx extension
& as per yours...

(1) Can You test backup or the real file with other computer, which 'works as normal as those would'? --That's necessary? because all runs goods on my own pc....before some days...i doubt that after install Apache & Access Database... this issue create...may...not sure...

(2) Have You checked - What settings GetObject needs? which setting i need to check?
(3) no just install Apache open office & Access Database engine ... and You're 100% that those no effect to Excel? -How to check this ?
(4) If You have same Excel-version with same settings then it should work as before ... means ... something has changed ... with settings!- in which settings windows setting?, excel setting? office settings? another application settings? its huge.to check . can you give some hint that which setting i shoulkd check? ? its for VBA editor settings? can i check to remove all reference from vba ? & re-reference all object libraries ? one by one?

Regards
Chirag Raval

vletm · Mar 16, 2020

Chirag R Raval
Do You figure - it's much possible to get wrong result than to get correct result!
... even one typo could mess many things!
... even one new installation could mess many things!
I've tried to give You some hints ... but seems that You don't want to check those.
... I cannot do those myself
... I cannot try to help more with this!

Chirag R Raval · Mar 17, 2020

Dear Sir @vletm

Thank you for your invaluable efforts to resolve this problem..
Based on all your effort & research on net...
(1) I uninstalled-Apache Open Office (which have also below visual c++ redistrubutable..

(2) Re-Install Micosoft Visual c++ Redestributable (2015-2019) after download from Microsoft's site (may which have all scipting.runtime engines.)
(3) repair Microsoftt office-2016
(4) Try to run -other this type of macros which have GetObject...sucessfully
(5) update my current not working macros -with "getobject(sig).copy" to "getobject(sig).range.copy

now successfully run my stopped macro.....

Thank you very much sir
Regards,
Chirag Raval

Chirag R Raval · Dec 2, 2022

Kenneth Hobson said:

Be sure to add the Archive folder or change the path. I did not address possible duplicates already moved to the Archive folder. I just skipped the move.

Code:

Sub Main()
  Dim T$, p$, a, e, r As Range, c As Range, pF$, S$, sig$, af$, afn$
  'Tools > References > Microsoft Scripting Runtime
  'Dim fso As New FileSystemObject
  Dim fso As Object
  Dim wb As Workbook, ws As Worksheet
  'Tools > References > Microsoft Outlook xx.0 Object Library > OK
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library > OK
  Dim Word As Document, wr As Word.Range, rTo As Recipient

  'INPUTS to change if needed...........................................................
  T = "ken@gmail.com"
  'p = "H:\WINT-17\1-W-17-ALL ORIGINAL FROM MILL\W-17-CONFIRMATION\*.*"
  p = "C:\Users\lenovo1\Dropbox\Excel\Outlook\emailPDFinvoices\*.*"
  Set wb = Workbooks.Open(ThisWorkbook.Path & "\SUITING-BUYER MASTER.xlsx", False, True)
  Set ws = wb.Worksheets("BUY MASTER")
  'File to copy content as signature for body of email.
  sig = ThisWorkbook.Path & "\sig.rtf"
  af = ThisWorkbook.Path & "\Archive\" 'Folder to move files to after attach and Send.
  'End INPUTS...........................................................................

  Set fso = CreateObject("Scripting.FileSystemObject")

  'Batch to get all filenames.
  a = aFFs(p)
  If Not IsArray(a) Then Exit Sub

  'Get Outlook application
  Set olApp = New Outlook.Application

  'Iterate all elements in a, filenames to attach.
  For Each e In a
    'Get 5-digit prefix of base filename.
    pF = fso.GetBaseName(e)
    If Len(pF) < 5 Then GoTo NextE
    pF = Left(pF, 5)

    'Find matching prefix "number" in usedrange G:H
    Set r = ws.Range("G1:H" & ws.Cells(ws.Rows.Count, "G").End(xlUp).Row).Find _
      (Val(pF), ws.[G1], , xlWhole)
    If r Is Nothing Then GoTo NextE

    'Set subject value:
    S = pF & "-" & ws.Cells(r.Row, "I").Value & ", (" & ws.Cells(r.Row, "J").Value & ")"

    'Copy content from sig.rtf as signature for body of email to clipboard.
    GetObject(sig).Range.Copy

    'Make email, attach file, and  send/display.
    'Set olMail = olApp.CreateItem(olMailItem)
    With olApp.CreateItem(olMailItem)
      .Subject = S
      .Importance = olImportanceNormal
  
      Set rTo = .Recipients.Add(pF)
      rTo.Resolve
      rTo.Type = olTo 'olcc, olbcc
      If rTo.Resolved = False Then
        Debug.Print pF, "Resolved=False"
        MsgBox pF & " email group does not exist." & _
          "Notice placed in VBE's Immediate Window.", _
          vbInformation, "Skipped Sending" & pF & " Group Email"
        GoTo NextE
      End If
      '.To = pF  'Using rTo for .To now.
    
      .GetInspector.Display
      Set Word = .GetInspector.WordEditor
      Word.Content = "Dear Sir, " & vbCrLf & vbCrLf & S & _
        vbCrLf & vbCrLf & "Confirmation Attached" _
        & vbCrLf & vbCrLf & _
        "Regards," & vbCrLf & "My name," & vbCrLf & _
        "Firm name, & Contact detail.."
  
      'Paste sig.rtf
      Set wr = Word.Content
      wr.Collapse Direction:=wdCollapseEnd
      wr.Paste

      .Attachments.Add e
      .Display
      '.Send
    End With
    With fso
      afn = af & .GetFileName(CStr(e))
      If Not .FileExists(afn) And .FolderExists(af) Then _
        .MoveFile CStr(e), afn
    End With
NextE:
  Next e

TheEnd:
  Set olMail = Nothing
  Set olApp = Nothing
  Set ws = Nothing
  wb.Close False
  Set wb = Nothing
End Sub

Dear Sir,,
Can i attatch /send 2 files same name ,but extension is different?
I already create .PDF from same file, same name but just extension is .PDF.
now i can't attach both file in same message , its create 2 separate mails for each file .
1 message for .xlsx file & 1 for .pdf, i wnat both files in same single mail.
Can you look in to the matter? it will be very helpful for me Sir,

Regards,
Chirag Raval

Chirag R Raval · Dec 2, 2022

Dear Sir @Kenneth Hobson ,

Can you help in your this great helping code?
Regards,
Chirag Raval

How to send each file in folder through outlook with conditional, ID, Subject & Body with Signature?

Active Member

Member

Member

Active Member

Member

Member

Active Member

Member

Member

Active Member

Member

Member

Attachments

Excel Ninja

Member

Excel Ninja

Member

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Member

Member