VBA to Outlook from Excel

[damienenglish]

Hi All

I have been working on a solution to extract certain data from a spreadsheet to email, which is then sent to a particular client. I need to be able to send multiple bunches of data to different clients. I have managed to put together the following script:

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open _
("C:\Users\desktop\CLW.xls")

IntRow = 2

Do Until objExcel.Cells(IntRow, 2).Value = "***SEND"
Wscript.Echo objExcel.Cells(IntRow, 2).Value
IntRow = IntRow + 1
Loop

objExcel.Quit

What I want to do, is to tell the script to search for a variable called: ***SEND and to them copy the proceeding data in all cells to an email until it comes across the next ***SEND in the spreadsheet.

Then I want to script to copy all data within the two ***SEND areas and paste it into an email in Outlook.

Does anyone have any suggestions on this? I have exhausted my VBA knowledge and am struggling a bit!

Many Thanks

 

[SkipVought]

hi,

I have been working on a solution to extract certain data from a spreadsheet...

Assuming that you are coding in an EXCEL workbook via VBA, then you do not need to create an Excel application object: you have a LIVE Excel application object, so...

[b]Dim objWorkbook as Workbook, ws as Worksheet[/b]

[s]Set objExcel = CreateObject("Excel.Application")[/s]
Set objWorkbook = [s]objExcel.[/s]Workbooks.Open _
    ("C:\Users\desktop\CLW.xls")


[b]Set ws = objWorkbook.Sheets(1)[/b] 'assuming that the first sheet is the one of interest


IntRow = 2
 

Do Until [s]objExcel[/s]  [b]ws[/b].Cells(IntRow, 2).Value = "***SEND"
    [s]Wscript.Echo[/s]  Debug.Print  [s]objExcel[/s]  [b]ws[/b].Cells(IntRow, 2).Value
    IntRow = IntRow + 1
Loop

'save the workbook or close the workbook

[s]objExcel.Quit[/s]

This is just the first step. Get this right and then we can continue.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[damienenglish]

Hi there

I have been writing this in a .txt file so far.

I am making the edits as suggested now.

Please advise the next stage.

Many Thanks for your help.

 

[SkipVought]

I have been writing this in a .txt file so far.

?????

If you are running a workbook, presumably CLW.xls, there is a VBA programing environment RIGHT IN THAT WORKBOOK!!!

alt+F11 opens the VB Editor.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[damienenglish]

Yeah I have just got to grips with that!

I have copied the text into it with your ammendments.

I am very new to VBA and using Excel in this type of depth. Never really had the reason to in the past!

 

[SkipVought]

Please explain exactly what workbook you have open, which will dictate whether you need to open some other workbook.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[damienenglish]

I have open the CLW.xls workbook open.

 

[SkipVought]

Dim ws as Worksheet
   
Set ws = ThisWorkbook.Sheets(1) 'assuming that the first sheet is the one of interest
   
IntRow = 2 
   
Do Until ws.Cells(IntRow, 2).Value = "***SEND"
    Debug.Print ws.Cells(IntRow, 2).Value
    IntRow = IntRow + 1
Loop

You can view the result of Debug.Print in the IMMEDIATE window under the View Menu item in the VB Editor.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[damienenglish]

Hi There

Many thanks for that.

So how do I then tell it to export the data into individual Outlook new email windows? This is what I am most confused about.

Many Thanks

 

[SkipVought]

What is the objective?

Simply to eMail something, with no user interaction with each eMail item?

Create text/attachment to be inserted into the current mail item, which means that the user interacts with each eMail item?

Do you want to export the data as simple text or as an attachment?

Where is your list of clients?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[damienenglish]

OK

The list of clients are within the spreadsheet as follows:

Client1

Client Data


CLient 2

Client Data

Etc Etc

I want to be able to export each of the client data and put each client data into a new outlook email, which will pickup the email address and subject field within the clients data.

Does this make sense?

 

[SkipVought]

I would say that your data structure is not a classic table structure, and as such, may be subject to problems yet unforseen.

THIS process COULD use that structure, but I would recommend that you recast the structure into a proper table. Each column in a table should contain similar data, for instance column A would be Client ID, column B would be Client Data and row 1 would contain those heading values or something similar. Every row and column in a table should contain at least on data element, in oither words, there should be not EMPTY row or column within a table.

Your response?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[damienenglish]

I agree with what you are saying, however, this spreadsheet has over 5000 lines of customer data and would take a long time to restructure it.

I just need to know if my current setup can do what I need for now as it is only a temporary measure.

Regards

 

[SkipVought]

Paste into a MODULE and RUN from the Macro Window or create a BUTTON and assign this macro. I have included a function I got here at Tek Tips from another member

Option Explicit

Sub MailToList()
    Dim ws As Worksheet, IntRow As Long, sClient As String, sData As String
    
    Set ws = ThisWorkbook.Sheets(1) 'assuming that the first sheet is the one of interest
    
    IntRow = 2
    
    Do Until ws.Cells(IntRow, 2).Value = "***SEND"
    '[b]assume that EVEN rows are Clients eMail Address/ODD rows are client Data[/b]
        Debug.Print ws.Cells(IntRow, 2).Value
        
        Select Case IntRow Mod 2
            Case 0
                If sClient <> "" Then
                    CdoSend sClient, "YourName", "What this eMail is about", sData
                End If
                sClient = ws.Cells(IntRow, 2).Value
            Case 1
                sData = ws.Cells(IntRow, 2).Value
        End Select
        
        IntRow = IntRow + 1
    Loop

End Sub



Public Function CdoSend(MailTo As String, MailFrom As String, Subject As String, MessageText As String, Optional CC As String, Optional BCC As String, Optional FileAttachment As String) As Boolean
On Error GoTo CdoSend_Err

' This example use late binding, you don't have to set a reference
' You must be online when you run the sub
    Dim oMsg As Object
    Dim oConf As Object
    Dim Flds As Variant
 
    Set oMsg = CreateObject("CDO.Message")
    Set oConf = CreateObject("CDO.Configuration")
 
        oConf.Load -1    ' CDO Source Defaults
        Set Flds = oConf.Fields
        With Flds
            .Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing")[/URL] = 2
            .Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver")[/URL] = "dfwmail.bh.textron.com"
            .Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserverport")[/URL] = 25
            .Update
        End With
 
    With oMsg
        Set .Configuration = oConf
        
        .To = MailTo
        .CC = CC
        .BCC = BCC
        .FROM = MailFrom
        
        .Subject = Subject
        .TextBody = MessageText

        
        If Len(FileAttachment & "") > 0 Then
            
            '## Last make sure the file actually exists and send it!:
            Dim fso
            Set fso = CreateObject("Scripting.FileSystemObject")
            If fso.FileExists(FileAttachment) Then
                .AddAttachment FileAttachment
            Else
                'otherwise return that the send failed and exit function:
                Debug.Print "[CdoSend.Error]=> File attachment path does not exist, quitting..."
                CdoSend = False
                Exit Function
            End If
        
        End If
    
        '## Send zee message! ##
        .sEnd
    
    End With

    Set fso = Nothing
    Set oMsg = Nothing
    Set oConf = Nothing
    
    CdoSend = True

CdoSend_Exit:
    Exit Function
    
CdoSend_Err:
    Debug.Print "[CdoSend.Error(" & Err.Number & ")]=> " & Err.Description
    CdoSend = False
    Resume CdoSend_Exit
End Function

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

Oh I failed to remind you to put your eMail address and the Message Subject in the approrpriate place in the statement...

  CdoSend sClient, "YourName", "What this eMail is about", sData

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[damienenglish]

Many thanks for all your help.

I will give that a go.