I want to be able to send an attachment file just by dropping it on a script.
I've found this one that sends the file (it works for me):
Set fso=CreateObject("Scripting.FileSystemObject")
strSMTP="smtp.gmail.com"
strSubject="mail#gmail.com"
strSubject2="Attachment file"
strBody="-"
strAttach="FILEPATH"
If fso.FileExists(strAttach) then
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/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mail#gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
.Update
End With
With iMsg
Set .Configuration = iConf
.To = "mail2#gmail.com"
.CC = ""
.BCC = ""
.From = "mail1#gmail.com"
.Subject = strAttach
.TextBody = strBody
.AddAttachment strAttach
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
Else
MsgBox "The specified attachment does not exist"
End if
What I need is a modification to this script that allows me to change the 6th line strAttach="FILEPATH" with the path and the extension of the file that im dropping on it and then execute the "send mail script".
Found this two links related to my question, but I don't know how to use them, hope these can help you too.
How to get the fully qualified path for a file in VBScript?
http://vba-tutorial.com/parsing-a-file-string-into-path-filename-and-extension/
The first one just shows the filepath and the extension on a new window, but i need it to be overwritten on the 6th line.
Could someone help me? im not a programmer, just want to be able to send the files to my own mail because i need to print them later on another computer.
Sorry for my english. Im not a native speaker. Thanks in advance!
Use Arguments Property (WScript Object):
The Arguments property contains the WshArguments object (a
collection of arguments). Use a zero-based index to retrieve
individual arguments from this collection.
Set fso=CreateObject("Scripting.FileSystemObject")
strSMTP="smtp.gmail.com"
strSubject="mail#gmail.com"
strSubject2="Attachment file"
strBody="-"
''''''''''''''''''''''''''''''''''' strAttach="FILEPATH"
Set objArgs = WScript.Arguments
For ii = 0 to objArgs.Count - 1
SendMyMail fso.GetAbsolutePathName(CStr( objArgs( ii)))
Next
Sub SendMyMail( ByVal strAttach)
If fso.FileExists(strAttach) then
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/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mail#gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
.Update
End With
With iMsg
Set .Configuration = iConf
.To = "mail2#gmail.com"
.CC = ""
.BCC = ""
.From = "mail1#gmail.com"
.Subject = strAttach
.TextBody = strBody
.AddAttachment strAttach
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
Else
MsgBox strAttach & vbCrLf & "The specified attachment does not exist"
End if
End Sub
Should work
using file(s) drag&drop as well as
using SendTo… from right-click menu (see shell:sendto: Customize the Send To Menu in Windows 10, 8, 7, or Vista).
Please check Paul Sadowski's article Sending email with CDO to simplify your code.
Related
This code is working well as long as every file is there.
What is missing in the code for sending an email even if a file is missing?
I have tried to find a solution but without success.
Set fso=CreateObject("Scripting.FileSystemObject")
strSMTP="smtp.telenor.no"
strSubject="Files form me to you"
strSubject="XXXXX"
strSubject="XXXX"
strBody="XXXXXX"
strAttach="File 1.csv"
strAttach1="File 2.csv"
strAttach2="File 3.csv"
If fso.FileExists(strAttach) then
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/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
With iMsg
Set .Configuration = iConf
.To = "XXXX"
.CC = ""
.BCC = ""
.From = "XXXX"
.Subject = strSubject
.TextBody = strBody
.AddAttachment strAttach
.AddAttachment strAttach1
.AddAttachment strAttach2
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
Else
MsgBox "The specified attachment does not exist"
End if
The following uses an ArrayList to hold your attachments and adds them to the message one by one, checking if the file exists first:
Dim iCounter
Dim sAttachment
Dim objAttachments
Set objAttachments = CreateObject("System.Collections.ArrayList")
objAttachments.Add "File 1.csv"
objAttachments.Add "File 2.csv"
objAttachments.Add "File 3.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
strSMTP = "smtp.telenor.no"
strSubject = "Files form me to you"
strSubject = "XXXXX"
strSubject = "XXXX"
strBody = "XXXXXX"
' Create message and configuration
Set objMessage = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")
objConf.Load -1 ' CDO Source Defaults
Set objFields = objConf.Fields
With objFields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
' Initalize message
With objMessage
Set .Configuration = objConf
.To = "XXXX"
.CC = ""
.BCC = ""
.From = "XXXX"
.Subject = strSubject
.TextBody = strBody
End With
' Add attachments
For iCounter = 1 To objAttachments.Count
sAttachment = objAttachments.Item(iCounter - 1)
If objFSO.FileExists(sAttachment) Then objMessage.AddAttachment sAttachment
Next
' Send Message
objMessage.Send
Set MyApp = CreateObject("Outlook.Application")
Set MyItem = MyApp.CreateItem(0) 'olMailItem
With MyItem
.To = Vdistro
.CC = Vregion
.Subject = Vsubject
.AddAttachment "C:\VzW\Ankur.txt"
.HTMLBody = EmailComments & EmailBody & "<br><b>Regards,</b>" + mysignature
'.Importance = Vimportance
'.FlagStatus = Vflagstatus
on above code everything working except attachment. I have also tried MyApp..AddAttachment "C:\VzW\Ankur.txt" but no luck.
The line
.AddAttachment "C:\VzW\Ankur.txt"
must be
.Attachments.Add "C:\VzW\Ankur.txt"
I bet you have On Error Resume Next somewhere. Please remove it - it masks all problems in your code.
set cdoConfig = CreateObject("CDO.Configuration")
with cdoConfig.Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "localhost"
.Item(cdoSMTPAuthenticate) = 1
.Item(cdoSendUsername) = "contact#example.com"
.Item(cdoSendPassword) = "password"
.Update
end with
set cdoMessage = CreateObject("CDO.Message")
with cdomessage
set .Configuration = cdoConfig
.From = "contact#example.com"
.To = email
.Subject = subject
.HTMLBody = message
.AddAttachment "c:/i/report.pdf"
.Send
end with
set cdomessage = nothing
set cdoconfig = nothing
Everything sends find, but the recipient gets the message as "Untitled Attachment 000X.pdf"
How do I give the attachment a name?
I have something like this. But never tried.
'With cdomessage
.AddAttachment "c:/i/report.pdf"
.Attachments(1).Fields.Item("urn:schemas:mailheader:content-disposition") ="attachment;filename=" & NEWNAME
.Attachments(1).Fields.Update
'End With
I'm very new to vbscript but here's what I have so far, Doesn't seem to be working though:
<script type="text/vbscript">
Sub Senmail()
Dim objOutlook As Object
Dim objOutlookMsg As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(0)
With objOutlookMsg
.To = "eric#gmail.com"
.Cc = "name#email.com"
.Subject = "Hello World (one more time)..."
.Body = "This is the body of message"
.HTMLBody = "HTML version of message"
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
</script>
Any input would be appreciated! Or any other ways I could send an email is my asp....
Here's one way using CDO / SMTP
Sub SendMail()
Set objMsg = CreateObject("CDO.Message")
Set objConfig = CreateObject("CDO.Configuration")
Set objFields = objConfig.Fields
With objFields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "YourSMTPServer"
.Update
End With
With objMsg
Set.Configuration = objConfig
.To = "eric#gmail.com"
.CC = "name#gmail.com"
.From = "you#gmail.com"
.Subject = "Hello World"
.HTMLBody = "This is the body of message"
.Fields.Update
.Send
End with
Set objMsg = Nothing
Set objConfig = Nothing
End Sub
For starters, remove the As Object from your Dim statements. In VBScript, you can't declare variables As any particular data type. Everything's a variant.
Dim objOutlook
Dim objOutlookMsg
If you want more help, then you may want to tell us something more specific about your problem than "Doesn't seem to be working" e.g. what error or wrong behaviour you are getting.
We want to upgrade our VB6 code to use Outlook 2010, but we're getting the following error:
Active x cannot create object
This is our current code:
Public Sub SendEmail()
Set emailOutlookApp = CreateObject("Outlook.Application.12")
Set emailNameSpace = emailOutlookApp.GetNamespace("MAPI")
Set emailFolder = emailNameSpace.GetDefaultFolder(olFolderInbox)
Set emailItem = emailOutlookApp.CreateItem(olMailItem)
Set EmailRecipient = emailItem.Recipients
EmailRecipient.Add (EmailAddress)
EmailRecipient.Add (EmailAddress2)
emailItem.Importance = olImportanceHigh
emailItem.Subject = "My Subject"
emailItem.Body = "The Body"
'-----Send the Email-----'
emailItem.Save
emailItem.Send
'-----Clear out the memory space held by variables-----'
Set emailNameSpace = Nothing
Set emailFolder = Nothing
Set emailItem = Nothing
Set emailOutlookApp = Nothing
Exit Sub
I'm not sure if "Outlook.Application.12" is correct. But I can't find a definitive answer for this.
For Outlook 2010, this is definitly corect Outlook.Application.14.
But, I don't know what about office 2007.
I think it's Outlook.Application.12 and for lower versions it is simply "Outlook.Application".
Here's the code I switched to for 2010:
Private Sub EmailBlahbutton_Click()
Dim mOutlookApp As Object
Dim OutMail As Object
Dim Intro As String
On Error GoTo ErrorHandler
Set mOutlookApp = GetObject("", "Outlook.application")
Set OutMail = mOutlookApp.CreateItem(0)
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'These are the ranges being emailed.
ActiveSheet.Range(blahblahblah).Select
'Intro is the first line of the email
Intro = "BLAHBLAHBLHA"
'Set the To and Subject lines. Send the message.
With OutMail
.To = "blahblah#blah.com"
.Subject = "More BLAH here"
.HTMLBody = Intro & RangetoHTML(Selection)
.Send
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
ActiveSheet.Range("A1").Select
ActiveWindow.ScrollColumn = ActiveCell.Column
ActiveWindow.ScrollRow = ActiveCell.Row
Set OutMail = Nothing
Set mOutlookApp = Nothing
Exit Sub
ErrorHandler:
Set mOutlookApp = CreateObject("Outlook.application")
Resume Next
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Why do you explicitly specify the version? Why not simply
Set emailOutlookApp = CreateObject("Outlook.Application")
Try "Outlook.Application.14". Not sure if this is related though: 2007 to 2010 upgrade issue
I realize it's not the exact issue, but it may lead you down the right path.