Re: $$Excel-Macros$$ Query in code of email send with attachment from excel
Before adding att check if attachment exists or not, if its null then you
will get error...
Cheers!!
On Mon, Mar 23, 2015 at 5:00 PM, Ashish Bhalara
wrote:
> Dear experts,
>
> See the attached file of email sending from excel. Normally mail send
> successfully to all together from database. I need attached file to some of
> party so I add column 'Attachment (Filename with path)' in sheet of 'Mail
> Data', file also send successfully as per path written but problem is that
> if file name and location not written, error occur of 'The spcified
> protocol is unknown'.
>
> Could you please edit in below coding that .addattachment code is only
> work if the value in cell F2 in sheet 'Mail' is not nill.
>
>
> Sub CDO_Mail_Small_Text_2()
> Dim iMsg As Object
> Dim iConf As Object
> Dim mailto As String, ccto As String, sItem As String
> Dim Flds As Variant
> Dim rng As Range, rngAttach1 As Range, rngAttach2 As Range, rngAttach3
> As Range
> Dim i As Integer
> Application.DisplayStatusBar = True
> Worksheets("Mail").Unprotect Password:="aryan"
>
> Set rngAttach1 = Worksheets("Mail").Range("f2")
> 'Set rngAttach2 = Worksheets("Mail").Range("f3")
> Set iMsg = CreateObject("CDO.Message")
> Set iConf = CreateObject("CDO.Configuration")
> iConf.Load -1' CDO Source Defaults
> Set Flds = iConf.Fields
> With Flds
> .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl";)
> = True
> .Item("
> http://schemas.microsoft.com/cdo/configuration/smtpauthenticate";) = 1
> .Item("http://schemas.microsoft.com/cdo/configuration/sendusername";)
> = "ashishbhalar...@gmail.com"
> .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword";)
> = "***"
> .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver";)
> = "smtp.gmail.com"
> .Item("http://schemas.microsoft.com/cdo/configuration/sendusing";)
> = 2
> .Item("
> http://schemas.microsoft.com/cdo/configuration/smtpserverport";) = 25
> .Update
> End With
>
> Application.ScreenUpdating = False
> With ActiveSheet.PivotTables("PivotTable2")
> .PivotCache.MissingItemsLimit = xlMissingItemsNone
> .PivotCache.Refresh
> With .PivotFields("Party's Name")
> '---hide all items except item 1
> .PivotItems(1).Visible = True
> For i = 2 To .PivotItems.Count
> .PivotItems(i).Visible = False
> Next
> For i = 1 To .PivotItems.Count
> .PivotItems(i).Visible = True
> If i <> 1 Then .PivotItems(i - 1).Visible = False
> sItem = .PivotItems(i)
>
> Set rng = Nothing
> On Error Resume Next
> Worksheets("mail").Range("e9:" &
> ActiveSheet.Range("e9").End(xlDown).Address).Select
> Range(Selection, Selection.End(xlToLeft)).Select
>
> Set rng = Selection.SpecialCells(xlCellTypeVisible)
>
> On Error GoTo 0
>
> 'If rng Is Nothing Then
> ' MsgBox "The selection is not a range or the sheet is protected" &
> _
> ' vbNewLine & "please correct and try again.", vbOKOnly
>' Exit Sub
> 'End If
>
> With Application
> .EnableEvents = False
> .ScreenUpdating = False
> End With
>
> Application.StatusBar = "Email sending to " &
> Sheets("Mail").Range("B1").Value & ", Email sent " & i - 1 & " out of " &
> .PivotItems.Count
> mailto = Sheets("Mail").Range("B5").Value
> ccto = Sheets("Mail").Range("B6").Value
> With iMsg
> Set .Configuration = iConf
> .To = mailto
> .CC = ccto
> '.BCC = ""
> .From = """ashish"" "
> .Subject = "Paymnet Detail of Dt." &
> Sheets("Mail").Range("B3").Value
> .HTMLBody = "Dear sir," & "" & "" & " Text Body 1" &
> "" & RangetoHTML(rng) & "" & _
> "Text Body2" _
> & "" & "" & "Regards." & "" & " " _
> & "" & " "
> .addattachment rngAttach1.Value (error occur here)
> '.addattachment rngAttach2.Value
> .Send
> End With
>
> Next i
> End With
> End With
> Application.DisplayStatusBar = False
>
> Worksheets("Mail").Protect DrawingObjects:=True, Contents:=True,
> Scenarios:=True _
> , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
> AllowFormattingRows:=True, AllowInsertingHyperlinks:=True,
> AllowSorting:= _
> True, AllowFiltering:=True, AllowUsingPivotTables:=True,
> Password:="aryan"
>
> With Application
> .EnableEvents = True
> .ScreenUpdating = True
> End With
> End Sub
>
> --
> Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
> =TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
> https://www.facebook.com/discussexcel
>
> FORUM RULES
>
> 1) Use concise, accurate thread titles. Poor thread titles, like Please
> Help, Urgent, Need Help, Formula Problem, Code Problem, and Need A
Re: $$Excel-Macros$$ Query in code of email send with attachment from excel
When value of path is null, function by default set 0 in cell F2, so I
tried below code to avoid error on path not written in cell. but though
same error is occur, pls do something in coding.
If ws.Range("F2") <> Chr(48) Then
.addattachment rngAttach1.Value
End If
On Mon, Mar 23, 2015 at 6:30 PM, Vaibhav Joshi wrote:
> Before adding att check if attachment exists or not, if its null then you
> will get error...
>
> Cheers!!
>
> On Mon, Mar 23, 2015 at 5:00 PM, Ashish Bhalara > wrote:
>
>> Dear experts,
>>
>> See the attached file of email sending from excel. Normally mail send
>> successfully to all together from database. I need attached file to some of
>> party so I add column 'Attachment (Filename with path)' in sheet of 'Mail
>> Data', file also send successfully as per path written but problem is that
>> if file name and location not written, error occur of 'The spcified
>> protocol is unknown'.
>>
>> Could you please edit in below coding that .addattachment code is only
>> work if the value in cell F2 in sheet 'Mail' is not nill.
>>
>>
>> Sub CDO_Mail_Small_Text_2()
>> Dim iMsg As Object
>> Dim iConf As Object
>> Dim mailto As String, ccto As String, sItem As String
>> Dim Flds As Variant
>> Dim rng As Range, rngAttach1 As Range, rngAttach2 As Range,
>> rngAttach3 As Range
>> Dim i As Integer
>> Application.DisplayStatusBar = True
>> Worksheets("Mail").Unprotect Password:="aryan"
>>
>> Set rngAttach1 = Worksheets("Mail").Range("f2")
>> 'Set rngAttach2 = Worksheets("Mail").Range("f3")
>> Set iMsg = CreateObject("CDO.Message")
>> Set iConf = CreateObject("CDO.Configuration")
>> iConf.Load -1' CDO Source Defaults
>> Set Flds = iConf.Fields
>> With Flds
>> .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl";)
>> = True
>> .Item("
>> http://schemas.microsoft.com/cdo/configuration/smtpauthenticate";) = 1
>> .Item("
>> http://schemas.microsoft.com/cdo/configuration/sendusername";) = "
>> ashishbhalar...@gmail.com"
>> .Item("
>> http://schemas.microsoft.com/cdo/configuration/sendpassword";) = "***"
>> .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver";)
>> = "smtp.gmail.com"
>> .Item("http://schemas.microsoft.com/cdo/configuration/sendusing";)
>> = 2
>> .Item("
>> http://schemas.microsoft.com/cdo/configuration/smtpserverport";) = 25
>> .Update
>> End With
>>
>> Application.ScreenUpdating = False
>> With ActiveSheet.PivotTables("PivotTable2")
>> .PivotCache.MissingItemsLimit = xlMissingItemsNone
>> .PivotCache.Refresh
>> With .PivotFields("Party's Name")
>> '---hide all items except item 1
>> .PivotItems(1).Visible = True
>> For i = 2 To .PivotItems.Count
>> .PivotItems(i).Visible = False
>> Next
>> For i = 1 To .PivotItems.Count
>> .PivotItems(i).Visible = True
>> If i <> 1 Then .PivotItems(i - 1).Visible = False
>> sItem = .PivotItems(i)
>>
>> Set rng = Nothing
>> On Error Resume Next
>> Worksheets("mail").Range("e9:" &
>> ActiveSheet.Range("e9").End(xlDown).Address).Select
>> Range(Selection, Selection.End(xlToLeft)).Select
>>
>> Set rng = Selection.SpecialCells(xlCellTypeVisible)
>>
>> On Error GoTo 0
>>
>> 'If rng Is Nothing Then
>> ' MsgBox "The selection is not a range or the sheet is protected"
>> & _
>> ' vbNewLine & "please correct and try again.", vbOKOnly
>>' Exit Sub
>> 'End If
>>
>> With Application
>> .EnableEvents = False
>> .ScreenUpdating = False
>> End With
>>
>> Application.StatusBar = "Email sending to " &
>> Sheets("Mail").Range("B1").Value & ", Email sent " & i - 1 & " out of " &
>> .PivotItems.Count
>> mailto = Sheets("Mail").Range("B5").Value
>> ccto = Sheets("Mail").Range("B6").Value
>> With iMsg
>> Set .Configuration = iConf
>> .To = mailto
>> .CC = ccto
>> '.BCC = ""
>> .From = """ashish"" "
>> .Subject = "Paymnet Detail of Dt." &
>> Sheets("Mail").Range("B3").Value
>> .HTMLBody = "Dear sir," & "" & "" & " Text Body 1" &
>> "" & RangetoHTML(rng) & "" & _
>> "Text Body2" _
>> & "" & "" & "Regards." & "" & " " _
>> & "" & " "
>> .addattachment rngAttach1.Value (error occur here)
>> '.addattachment rngAttach2.Value
>> .Send
>> End With
>>
>> Next i
>> End With
>> End With
>> Application.DisplayStatusBar = False
>>
>> Worksheets("Mail").Protect DrawingObjects:=True, Contents:=True,
>> Scenarios:=True _
>> , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
>> AllowFormattingRows:=True, AllowInsertingHyperlinks:=True,
>> AllowSorting:= _
>> True, AllowFiltering:=True, AllowUsingPivotTables:=True,
Re: $$Excel-Macros$$ Query in code of email send with attachment from excel
Replace .addattachment rngAttach1.Value with
If Dir(rngAttach1.Value) <> "" Then
.addattachment rngAttach1.Value
End If
Cheers!!
On Tue, Mar 24, 2015 at 9:05 AM, Ashish Bhalara
wrote:
> When value of path is null, function by default set 0 in cell F2, so I
> tried below code to avoid error on path not written in cell. but though
> same error is occur, pls do something in coding.
>
> If ws.Range("F2") <> Chr(48) Then
> .addattachment rngAttach1.Value
> End If
>
>
> On Mon, Mar 23, 2015 at 6:30 PM, Vaibhav Joshi wrote:
>
>> Before adding att check if attachment exists or not, if its null then you
>> will get error...
>>
>> Cheers!!
>>
>> On Mon, Mar 23, 2015 at 5:00 PM, Ashish Bhalara <
>> ashishbhalar...@gmail.com> wrote:
>>
>>> Dear experts,
>>>
>>> See the attached file of email sending from excel. Normally mail send
>>> successfully to all together from database. I need attached file to some of
>>> party so I add column 'Attachment (Filename with path)' in sheet of 'Mail
>>> Data', file also send successfully as per path written but problem is that
>>> if file name and location not written, error occur of 'The spcified
>>> protocol is unknown'.
>>>
>>> Could you please edit in below coding that .addattachment code is only
>>> work if the value in cell F2 in sheet 'Mail' is not nill.
>>>
>>>
>>> Sub CDO_Mail_Small_Text_2()
>>> Dim iMsg As Object
>>> Dim iConf As Object
>>> Dim mailto As String, ccto As String, sItem As String
>>> Dim Flds As Variant
>>> Dim rng As Range, rngAttach1 As Range, rngAttach2 As Range,
>>> rngAttach3 As Range
>>> Dim i As Integer
>>> Application.DisplayStatusBar = True
>>> Worksheets("Mail").Unprotect Password:="aryan"
>>>
>>> Set rngAttach1 = Worksheets("Mail").Range("f2")
>>> 'Set rngAttach2 = Worksheets("Mail").Range("f3")
>>> Set iMsg = CreateObject("CDO.Message")
>>> Set iConf = CreateObject("CDO.Configuration")
>>> iConf.Load -1' CDO Source Defaults
>>> Set Flds = iConf.Fields
>>> With Flds
>>> .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl";)
>>> = True
>>> .Item("
>>> http://schemas.microsoft.com/cdo/configuration/smtpauthenticate";) = 1
>>> .Item("
>>> http://schemas.microsoft.com/cdo/configuration/sendusername";) = "
>>> ashishbhalar...@gmail.com"
>>> .Item("
>>> http://schemas.microsoft.com/cdo/configuration/sendpassword";) = "***"
>>> .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver";)
>>> = "smtp.gmail.com"
>>> .Item("http://schemas.microsoft.com/cdo/configuration/sendusing";)
>>> = 2
>>> .Item("
>>> http://schemas.microsoft.com/cdo/configuration/smtpserverport";) = 25
>>> .Update
>>> End With
>>>
>>> Application.ScreenUpdating = False
>>> With ActiveSheet.PivotTables("PivotTable2")
>>> .PivotCache.MissingItemsLimit = xlMissingItemsNone
>>> .PivotCache.Refresh
>>> With .PivotFields("Party's Name")
>>> '---hide all items except item 1
>>> .PivotItems(1).Visible = True
>>> For i = 2 To .PivotItems.Count
>>> .PivotItems(i).Visible = False
>>> Next
>>> For i = 1 To .PivotItems.Count
>>> .PivotItems(i).Visible = True
>>> If i <> 1 Then .PivotItems(i - 1).Visible = False
>>> sItem = .PivotItems(i)
>>>
>>> Set rng = Nothing
>>> On Error Resume Next
>>> Worksheets("mail").Range("e9:" &
>>> ActiveSheet.Range("e9").End(xlDown).Address).Select
>>> Range(Selection, Selection.End(xlToLeft)).Select
>>>
>>> Set rng = Selection.SpecialCells(xlCellTypeVisible)
>>>
>>> On Error GoTo 0
>>>
>>> 'If rng Is Nothing Then
>>> ' MsgBox "The selection is not a range or the sheet is protected"
>>> & _
>>> ' vbNewLine & "please correct and try again.", vbOKOnly
>>>' Exit Sub
>>> 'End If
>>>
>>> With Application
>>> .EnableEvents = False
>>> .ScreenUpdating = False
>>> End With
>>>
>>> Application.StatusBar = "Email sending to " &
>>> Sheets("Mail").Range("B1").Value & ", Email sent " & i - 1 & " out of " &
>>> .PivotItems.Count
>>> mailto = Sheets("Mail").Range("B5").Value
>>> ccto = Sheets("Mail").Range("B6").Value
>>> With iMsg
>>> Set .Configuration = iConf
>>> .To = mailto
>>> .CC = ccto
>>> '.BCC = ""
>>> .From = """ashish"" "
>>> .Subject = "Paymnet Detail of Dt." &
>>> Sheets("Mail").Range("B3").Value
>>> .HTMLBody = "Dear sir," & "" & "" & " Text Body 1" &
>>> "" & RangetoHTML(rng) & "" & _
>>> "Text Body2" _
>>> & "" & "" & "Regards." & "" & " " _
>>> & "" & " "
>>> .addattachment rngAttach1.Value (error occur here)
>>> '.addattachment rngAttach2.Value
>>> .Send
>>> End With
>>>
>>> Next i
>>> End With
>>> End With
>>> App
