Solved: Send a copy of Excel file.

[Marcster]

The code below helped me with a previous thread and
was submitted kindly by xld.


[VBA] 'Coded by xld
'Remove all VBA code in all modules:
Dim oVBComp As Object
Dim oVBComps As Object

Set oVBComps = ActiveWorkbook.VBProject.VBComponents


For Each oVBComp In oVBComps
Select Case oVBComp.Type
Case 1, 3, 2
oVBComps.Remove oVBComp
Case Else
With oVBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next oVBComp [/VBA]





Can the above be extended so it saves a copy of the workbook to disk
then sends that copy as an attachment via Outlook 2000?.
Thanks,

Marcster

[XLGibbs]

Certainly!

Is your intent to open the email with the file attached? or just send it to designated distribution?

Also, assuming the file is first saved somewhere WITH the components, saving it elsewhere subsequently is pretty simple..

How will the filename and path be determined ? (or desired?) cell references ?

I have to come back to this one a bit later but think I can help you out, helpful if the above are answered first, but if not I will post an alterable sample...

[Marcster]

Hi Gibbs ,
Thanks for replying.

Is your intent to open the email with the file attached?

Before sending?, yes that would be useful so I can check everything is ok before sending. If not, just send it.

or just send it to designated distribution?

It will be sent to just one email address, say someoneATsomewhereDotcom

How will the filename and path be determined ? (or desired?) cell references ?

Original filename say, Book1.xls Copy called Book1 - (Today's date).xls i.e. Book1-04/02/06.xls


If possible I would really like a macro that removes all the
VBA code and modules in the file, saves a copy to disk,
adding todays date to the end of the filename,
anywhere will do, temp folder?, then e-mail that saved
copy file as an attachment via Outlook 2000 then
delete that copy off the hard drive.

I know I could place the VBA code in my Personal.xls
or various other ways but I would like a macro to be able to do this.

I'm using Windows XP Pro and the original workbook
resides on my desktop if that helps.

Thanks,

Marcster.

[XLGibbs]

Okay, you can likely modify this...
[VBA]


Dim WB1 as Workbook, strFileName as string, strPath as string

Set WB1 = ThisWorkbook
Application.DisplayAlerts = False

'First save the working copy with all code:
WB1.Save

'SaveAs a copy with date
strFileName = ThisWorkbook.Name & Format(now(),"_mm_dd_yyyy")
strPath = "C:\MyDocuments" 'change the path to your desired...

ThisWorkbook.SaveAs strPath & "\" & strFileName

'Insert your code deletion code here


'Below line brings up the dialog for sending the file as an attachment
Application.Dialogs(xlDialogSendMail).Show


See if this stuff get you started..[/VBA]

[Marcster]

Thanks Gibbs,

I'll give it a go and tell you how I got on.

Marcster.

[Zack Barresse]

Hey Marcster,

I don't really like SendMail too much. I use Outlook. This should work w/ OL 2000; you must set a reference (VBE | Tools | References) to Microsoft Outlook 9.0 Object Library ...

[vba]Sub SendActiveWorkbook()

Dim OL As Outlook.Application
Dim OLmsg As Outlook.MailItem
Dim wb As Workbook
Dim strTmpPath As String, strName As String
Dim strPath As String, strKillPath As String
Dim Msg As VbMsgBoxResult
Dim IsCreated As Boolean

If ActiveWorkbook Is Nothing Then Exit Sub

Msg = MsgBox("Are you sure you want to send the ActiveWorkbook without any code?", _
vbYesNo, "Email ActiveWorkbook?")
If Msg = vbNo Then Exit Sub

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

Set wb = ActiveWorkbook
strName = Left(wb.Name, InStr(1, wb.Name, ".") - 1)
strPath = wb.Path
strTmpPath = "C:\" 'temporary path
strKillPath = strTmpPath & strName & " " & Format(Date, "dd-mm-yy") & ".xls"
ActiveWorkbook.SaveAs strKillPath
Call DeleteAllModules(ActiveWorkbook)
ActiveWorkbook.Close True
Workbooks.Open strPath & "\" & strName & ".xls"

On Error Resume Next
Set OL = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set OL = CreateObject("Outlook.Application")
IsCreated = True
End If
Set OLmsg = OL.CreateItem(olMailItem)
OLmsg.To = "ToSomeobdy@TheirDomain.com"
OLmsg.Subject = ""
OLmsg.Attachments.Add strKillPath
OLmsg.Display

Kill strKillPath
If IsCreated Then OL.Quit

Set OL = Nothing
Set OLmsg = Nothing
Set wb = Nothing

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Sub DeleteAllModules(wkb As Workbook)
Dim oVBComp As Object
Dim oVBComps As Object
Dim i As Long
Set oVBComps = wkb.VBProject.VBComponents
i = 1
For i = oVBComps.Count To 1 Step -1
Set oVBComp = oVBComps.Item(i)
Select Case oVBComp.Type
Case 1, 3, 2
If oVBComps.Item(i).Name = "Module3" Then GoTo SkipComp
oVBComps.Remove oVBComp
Case Else
With oVBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
SkipComp:
Next i
End Sub[/vba]

You shouldn't see too much going on. I think it is up to your specs. Works for me.

Edit: Btw, I used the Delete modules procedure from the other thread, just changed the workbook reference.

[Marcster]

Thanks firefytr,

Another thread solved.

Marcster.

[Marcster]

I've come across a problem with the above code.
I've changed it slighlty to remove all modules.

My workbook uses
Workbook_BeforeClose(Cancel As Boolean)
and
Workbook_Open
events.
and it appears your code doesn't work if the above events are used.

Do you know how to modify your code to make it work?.
It saves the workbook, closes the workbook,
but then doesn't re-open the copy.
Just stops with Excel showing without no workbook.
No error message or anything.

I have SendActiveWorkbook in my PERSONAL.XLS
Many thanks,

Marcster.

[Zack Barresse]

Not sure what you mean. If you have events that fire and you do not want them to fire when performing a task, just disable events ...

[vba]Application.enableevents = false
'.. code
Application.enableevents = true[/vba]

Is that what you mean?

[bacon]

Hi guys...

My VBA knowledge is zero but am willing to learn... This thread is on the way to what i need but i was hoping for some more help..

I have a spreadsheet that I need to email automatically as a CSV file at 18.30 every evening to one maybe two addresses. I would like the CSV file to be saved using the following metholodgy... data_472_20060209_1830.csv. Quite simple this will be static text "data_472_" followed by the year "2006", month "02" then day "09" followed by an underscore then followed by the time "1830".csv

Can anyone help me???

Thanks

Iain