× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



> > Do you know that an Excel spreadsheet can contain a Query Definition
and
> > can be programmed to automatically refresh the data downloaded and then
> > email itself out?
>
> Do tell?  Show me.

I assume you want the email portion.  Here is some basic code.

---------------------------------------------------------------------------
--------------

'
'   sndWithOE - Mail through the Default Mail Program (Outlook Express)
'
Sub sndWithOE(strSubject As String, strFileName As String)
    Dim wbkNewWorkbook As Workbook

    Workbooks.Open FileName:=strFileName
    Set wbkNewWorkbook = ActiveWorkbook
    ActiveWorkbook.SendMail Recipients:=getToEmails, Subject:=strSubject,
returnreceipt:=False
    ActiveWorkbook.Close

End Sub

'
'   sndWithOL - Mail through Outlook Object
'
Sub sndWithOL(strSubject As String, strExcelName As String, strFileName As
String)

    Dim olkApp As Outlook.Application
    Dim olkNameSpace As Outlook.NameSpace
    Dim olkOutBox As Outlook.MAPIFolder
    Dim olkMailItem As Outlook.MailItem

    Set olkApp = CreateObject("Outlook.Application")
    Set olkNameSpace = olkApp.GetNamespace("Mapi")
    Set olkOutBox = olkNameSpace.GetDefaultFolder(olFolderOutbox)
    Set olkMailItem = olkApp.CreateItem(olMailItem)

    With olkMailItem
        .To = getToEmails
        .Subject = strSubject
        .Attachments.Add strExcelName, olByValue, , strFileName
        .DeleteAfterSubmit = True
        .Send
    End With

    Set olkMailItem = Nothing
    Set olkOutBox = Nothing
    Set olkNameSpace = Nothing
    Set olkApp = Nothing

End Sub

'
' getToEmails - The addresses are stored on the spreadsheet.
'

Function getToEmails() As String
    Dim rngEmails As Range

    getToEmails = ""
    For Each rngEmails In
ThisWorkbook.Worksheets("shtProcess").Range("D3..D32")
        If rngEmails.Value > " " Then
            getToEmails = getToEmails & ";" & rngEmails.Value
        End If
    Next rngEmails
    getToEmails = Mid(getToEmails, 2) ' Drop the first semi-colon

End Function

---------------------------------------------------------------------------
-------------

Bill



As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.