VBS Email From

Hi,

pls try

' Subroutine to send the email with the file attached
Sub Email(MailFrom, MailTo, Subject, Body, Attachments)
    Set App = CreateObject("Outlook.Application")
   
    FoundAccount = False

    'loop through and find Outlook account based on from email address
    Set olAccounts = App.Application.Session.Accounts
    For Each olAccountTemp In olAccounts
        If (olAccountTemp.smtpAddress = MailFrom) Then
            Set olAccount = olAccountTemp
            FoundAccount = True
            Exit For
        End If
    Next


    If (FoundAccount) Then
        Set olMail = App.CreateItem(0)
        With olMail
            .SendUsingAccount = olAccount
            .To = MailTo
            .CC = ""
            .BCC = "mail@mail.com"
            .Subject = Subject
            .HTMLBody = "***** " & Body & " *****"
        End With
        Set MsgAttachments = Item.Attachments
        For Each Attachment In Split(Attachments, ",")
            MsgAttachments.Add Attachment
        Next
        Item.Send
    End If
End Sub

Select allOpen in new window

Regards

Hello,
it is not sending any email.

where do I put the mailfrom account info?

Thanks,

Hello,
I added the MailFrom into the Specify email related info section
but still not sending.

this is what I have


' Define location and names for file selection
strBaseDir = "C:\Users\Wassim.QA-DOMAIN\Desktop\Export Invoices"
strBaseName = "4667-"

arrExt = Array(".csv", ".txt", ".pdf" ,"xls" ,"xlsx")

' Specify email related information
MailFrom = "mail@mail.com"
MailTo = "mail@mail.com"
Subject = "Files"
Body = "***** Please see attached *****"

' Create file system object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Access the folder where the files exist
Set objFolder = objFSO.GetFolder(strBaseDir)

' Process all files in this folder, and look for name matches
For Each objFile in objFolder.Files
   If CheckFileName(objFile.Name) Then
      Attachments = Attachments & "," & objFile.Path
   End If
Next

If Left(Attachments, 1) = "," Then
   Attachments = Mid(Attachments, 2)
End If

If Attachments <> "" Then
   Email MailFrom, MailTo, Subject, Body, Attachments
End If

' Subroutine to send the email with the file attached
Sub Email(MailFrom, MailTo, Subject, Body, Attachments)
    Set App = CreateObject("Outlook.Application")
   
    FoundAccount = False

    'loop through and find Outlook account based on from email address
    Set olAccounts = App.Application.Session.Accounts
    For Each olAccountTemp In olAccounts
        If (olAccountTemp.smtpAddress = MailFrom) Then
            Set olAccount = olAccountTemp
            FoundAccount = True
            Exit For
        End If
    Next

    If (FoundAccount) Then
        Set olMail = App.CreateItem(0)
        With olMail
            .SendUsingAccount = olAccount
            .To = MailTo
            .CC = ""
            .BCC = "mail@mail.com"
            .Subject = Subject
            .HTMLBody = "***** " & Body & " *****"
        End With
        Set MsgAttachments = Item.Attachments
        For Each Attachment In Split(Attachments, ",")
            MsgAttachments.Add Attachment
        Next
        Item.Send
    End If
End Sub
     
' Function to determine if we should process this file or not
Function CheckFileName(strName)
   ' Assume we don't process it
   CheckFileName = False

   ' Check start of file name for a match
   If LCase(Left(strName, Len(strBaseName))) = LCase(strBaseName) Then
      ' Check included file types and see if we want this one
      For Each strExt in arrExt
         If LCase(Right(strName, Len(strExt))) = LCase(strExt) Then
            CheckFileName = True
            Exit For
         End If
      Next
   End If
End Function

I forgot to mention,
I get error

Line 62
Char 9
Error Object required: Item

thanks

Hi,

Corrected code

' Define location and names for file selection
strBaseDir = "C:\Users\Wassim.QA-DOMAIN\Desktop\Export Invoices"
strBaseName = "4667-"

arrExt = Array(".csv", ".txt", ".pdf" ,"xls" ,"xlsx")

' Specify email related information
MailFrom = "mail@mail.com"
MailTo = "mail@mail.com"
Subject = "Files"
Body = "***** Please see attached *****"

' Create file system object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Access the folder where the files exist
Set objFolder = objFSO.GetFolder(strBaseDir)

' Process all files in this folder, and look for name matches
For Each objFile in objFolder.Files
   If CheckFileName(objFile.Name) Then
      Attachments = Attachments & "," & objFile.Path
   End If
Next

If Left(Attachments, 1) = "," Then
   Attachments = Mid(Attachments, 2)
End If

If Attachments <> "" Then
   Email MailFrom, MailTo, Subject, Body, Attachments
End If

' Subroutine to send the email with the file attached
Sub Email(MailFrom, MailTo, Subject, Body, Attachments)
    Set App = CreateObject("Outlook.Application")
   
    FoundAccount = False

    'loop through and find Outlook account based on from email address
    Set olAccounts = App.Application.Session.Accounts
    For Each olAccountTemp In olAccounts
        If (olAccountTemp.smtpAddress = MailFrom) Then
            Set olAccount = olAccountTemp
            FoundAccount = True
            Exit For
        End If
    Next

    If (FoundAccount) Then
        Set olMail = App.CreateItem(0)
        With olMail
            .SendUsingAccount = olAccount
            .To = MailTo
            .CC = ""
            .BCC = "mail@mail.com"
            .Subject = Subject
            .HTMLBody = "***** " & Body & " *****"
        End With
        Set MsgAttachments = olMail.Attachments
        For Each Attachment In Split(Attachments, ",")
            MsgAttachments.Add Attachment
        Next
        Item.Send
    End If
End Sub
     
' Function to determine if we should process this file or not
Function CheckFileName(strName)
   ' Assume we don't process it
   CheckFileName = False

   ' Check start of file name for a match
   If LCase(Left(strName, Len(strBaseName))) = LCase(strBaseName) Then
      ' Check included file types and see if we want this one
      For Each strExt in arrExt
         If LCase(Right(strName, Len(strExt))) = LCase(strExt) Then
            CheckFileName = True
            Exit For
         End If
      Next
   End If
End Function 

Select allOpen in new window

Regards

Hello,
I still get error

Line 64
Char 9
Error Object Required:  Item
code 800A01A8

Thanks,

forgot the last "item"

' Define location and names for file selection
strBaseDir = "C:\Users\Wassim.QA-DOMAIN\Desktop\Export Invoices"
strBaseName = "4667-"

arrExt = Array(".csv", ".txt", ".pdf" ,"xls" ,"xlsx")

' Specify email related information
MailFrom = "mail@mail.com"
MailTo = "mail@mail.com"
Subject = "Files"
Body = "***** Please see attached *****"

' Create file system object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Access the folder where the files exist
Set objFolder = objFSO.GetFolder(strBaseDir)

' Process all files in this folder, and look for name matches
For Each objFile in objFolder.Files
   If CheckFileName(objFile.Name) Then
      Attachments = Attachments & "," & objFile.Path
   End If
Next

If Left(Attachments, 1) = "," Then
   Attachments = Mid(Attachments, 2)
End If

If Attachments <> "" Then
   Email MailFrom, MailTo, Subject, Body, Attachments
End If

' Subroutine to send the email with the file attached
Sub Email(MailFrom, MailTo, Subject, Body, Attachments)
    Set App = CreateObject("Outlook.Application")
   
    FoundAccount = False

    'loop through and find Outlook account based on from email address
    Set olAccounts = App.Application.Session.Accounts
    For Each olAccountTemp In olAccounts
        If (olAccountTemp.smtpAddress = MailFrom) Then
            Set olAccount = olAccountTemp
            FoundAccount = True
            Exit For
        End If
    Next

    If (FoundAccount) Then
        Set olMail = App.CreateItem(0)
        With olMail
            .SendUsingAccount = olAccount
            .To = MailTo
            .CC = ""
            .BCC = "mail@mail.com"
            .Subject = Subject
            .HTMLBody = "***** " & Body & " *****"
        End With
        Set MsgAttachments = olMail.Attachments
        For Each Attachment In Split(Attachments, ",")
            MsgAttachments.Add Attachment
        Next
        olMail.Send
    End If
End Sub
     
' Function to determine if we should process this file or not
Function CheckFileName(strName)
   ' Assume we don't process it
   CheckFileName = False

   ' Check start of file name for a match
   If LCase(Left(strName, Len(strBaseName))) = LCase(strBaseName) Then
      ' Check included file types and see if we want this one
      For Each strExt in arrExt
         If LCase(Right(strName, Len(strExt))) = LCase(strExt) Then
            CheckFileName = True
            Exit For
         End If
      Next
   End If
End Function 

Select allOpen in new window

Appreciate your time and help,
it is working, but , it is not sending from the set MAILFROM email address.

it is sending the email from the outlook default address.

thanks,

Just to be sure which Office Version do you have

because this a function new in OL2007

Outlook 2007.

I have about  9 email accounts

it is always picking up the default email address to send from.

Thanks,

Hi

pls try this to see which account you can Access

Sub TestMail()
    Set App = CreateObject("Outlook.Application")
    
    'loop through and find Outlook account based on from email address
    Set olAccounts = App.Application.Session.Accounts
    For Each olAccountTemp In olAccounts
        MsgBox olAccountTemp
    Next
End Sub

Select allOpen in new window

Regards

If  I run the Sub from Outlook,
I get this error message.

Compile Error
Assigned to constant and permitted.
 
olAccounts =

thanks.

Hi,

try this one

Sub TestMail()
    Set App = CreateObject("Outlook.Application")
    
    'loop through and find Outlook account based on from email address
    Set olAccounts = App.Session.Accounts
    For Each olAccountTemp In olAccounts
        MsgBox olAccountTemp
    Next
End Sub

Select allOpen in new window

Hello,

Compile Error
Assignment  to constant not permitted.

olAccounts =

Thanks

Assignment  to constant not permitted.

•You tried to assign a new value to a variable declared with Const, or to a type library constant. If you need to assign a new value, declare an ordinary variable of the type desired and assign your value to that variable. If you need a variable with a restricted set of values, you can declare an enumeration, using the Enum statement.

maybe try the code in a new Project

regards

if I run the sub in Excel,
I get no errors.
I hit an OK message for each email account.

thanks

Where was the code before?

and was the email you wanted to send with typed as you typed it in the code?

outlook,
thanks

Hi,

Because it doesn't make sense to call Outlook inside Outlook

' Subroutine to send the email with the file attached
Sub Email(MailFrom, MailTo, Subject, Body, Attachments)
   Set App = CreateObject("Outlook.Application")

pls try now

' Subroutine to send the email with the file attached
Sub Email(MailFrom, MailTo, Subject, Body, Attachments)
   
    FoundAccount = False

    'loop through and find Outlook account based on from email address
    Set olAccounts = Application.Session.Accounts
    For Each olAccountTemp In olAccounts
        If (olAccountTemp.smtpAddress = MailFrom) Then
            Set olAccount = olAccountTemp
            FoundAccount = True
            Exit For
        End If
    Next

    If (FoundAccount) Then
        Set olMail = CreateItem(0)
        With olMail
            .SendUsingAccount = olAccount
            .To = MailTo
            .CC = ""
            .BCC = "mail@mail.com"
            .Subject = Subject
            .HTMLBody = "***** " & Body & " *****"
        End With
        Set MsgAttachments = olMail.Attachments
        For Each Attachment In Split(Attachments, ",")
            MsgAttachments.Add Attachment
        Next
        olMail.Send
    End If
End Sub

Select allOpen in new window

Sorry, I think I misunderstood ,
when you sent me the 2 test subs,
I was testing them by themselves outside the Main script.

if I try the full code in vbs (DOUBLE CLICKING)
I get error
LINE 41
CHAR 2
ERROR: OBJECT REQUIRED: APPLICATION


' Define location and names for file selection
strBaseDir = "C:\Users\Wassim.QA-DOMAIN\Desktop\Export Invoices"
strBaseName = "4667-"

arrExt = Array(".csv", ".txt", ".pdf" ,"xls" ,"xlsx")

' Specify email related information
MailFrom = "mail@mail.com"
MailTo = "mail@mail.com"
Subject = "Files"
Body = "***** Please see attached *****"

' Create file system object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Access the folder where the files exist
Set objFolder = objFSO.GetFolder(strBaseDir)

' Process all files in this folder, and look for name matches
For Each objFile in objFolder.Files
   If CheckFileName(objFile.Name) Then
      Attachments = Attachments & "," & objFile.Path
   End If
Next

If Left(Attachments, 1) = "," Then
   Attachments = Mid(Attachments, 2)
End If

If Attachments <> "" Then
   Email MailFrom, MailTo, Subject, Body, Attachments
End If


' Subroutine to send the email with the file attached
Sub Email(MailFrom, MailTo, Subject, Body, Attachments)

    FoundAccount = False

    'loop through and find Outlook account based on from email address
      Set olAccounts = Application.Session.Accounts
    For Each olAccountTemp In olAccounts
        If (olAccountTemp.smtpAddress = MailFrom) Then
            Set olAccount = olAccountTemp
            FoundAccount = True
            Exit For
        End If
    Next

    If (FoundAccount) Then
        Set olMail = CreateItem(0)
        With olMail
            .SendUsingAccount = olAccount
            .To = MailTo
            .CC = ""
            .BCC = "mail@mail.com"
            .Subject = Subject
            .HTMLBody = "***** " & Body & " *****"
        End With
        Set MsgAttachments = olMail.Attachments
        For Each Attachment In Split(Attachments, ",")
            MsgAttachments.Add Attachment
        Next
        olMail.Send
    End If
End Sub
                                           
' Function to determine if we should process this file or not
Function CheckFileName(strName)
   ' Assume we don't process it
   CheckFileName = False

   ' Check start of file name for a match
   If LCase(Left(strName, Len(strBaseName))) = LCase(strBaseName) Then
      ' Check included file types and see if we want this one
      For Each strExt in arrExt
         If LCase(Right(strName, Len(strExt))) = LCase(strExt) Then
            CheckFileName = True
            Exit For
         End If
      Next
   End If
End Function

Hi,

Do you mean?

Set olMail = CreateItem(0) then replace by Set olMail = Application.CreateItem(0)

Hello,
I replaced
Set olMail = CreateItem(0)  WITH  Set olMail = Application.CreateItem(0)

I still get error
Line 43
Char 5
Error: Object required: Aapplication

Line 43 is
    Set olAccounts = Application.Session.Accounts

thanks,

let's try a diferent approach dclaring all the OL variables:

Sub Email(MailFrom, MailTo, Subject, Body, Attachments)

    Dim olSession As Outlook.Namespace
    Dim olAccounts As Outlook.Accounts
    Dim olAccount As Outlook.Account
    Dim olAccountTemp As Outlook.Account
    
    Set olSession = Application.Session
    
    Set olAccounts = olSession.Accounts

    FoundAccount = False

    'loop through and find Outlook account based on from email address

    For Each olAccountTemp In olAccounts
        If (olAccountTemp.smtpAddress = MailFrom) Then
            Set olAccount = olAccountTemp
            FoundAccount = True
            Exit For
        End If
    Next

    If (FoundAccount) Then
        Set olMail = CreateItem(0)
        With olMail
            .SendUsingAccount = olAccount
            .To = MailTo
            .CC = ""
            .BCC = "mail@mail.com"
            .Subject = Subject
            .HTMLBody = "***** " & Body & " *****"
        End With
        Set MsgAttachments = olMail.Attachments
        For Each Attachment In Split(Attachments, ",")
            MsgAttachments.Add Attachment
        Next
        olMail.Send
    End If
End Sub

Select allOpen in new window

Hello,

Line 38
Char 19
Error: Expected end of statement
code 800A0401

    Dim olSession As Outlook.Namespace

Thanks,

very much appreciated.
thank you for your time and help.
works great.