Heres my code which is attached to a button on a userform. unfortunately
I will try to ask them to save it to PC but I would prefer it if they
dont as this should be an automated procedure.
Private Sub CommandButton1_Click()
Sheets("data").Visible = True
Sheets("data").Select
Range("f1") = ComboBox1.Value
Range("A7").Select
Set exportfind = Cells.Find(What:="download", after:=Range("a7"),
LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False)
If ActiveCell.Row < 7 Then
MsgBox ("There is no data for the month you have selected.")
End If
If exportfind Is Nothing Then
MsgBox ("There is no data for the month you have selected.")
Else
MsgBox ("Please insert a floppy disk into the floppy drive and when
you are ready to export click th OK button.")
exportplace = Range("b3").Value
exportname = Range("b2").Value
exportmonth = Range("k1").Value
exportfile = "A:\" & exportplace & "-" & exportmonth & "data.csv"
Range("A7").Select
Selection.AutoFilter
Selection.AutoFilter Field:=12, Criteria1:="Download"
Selection.CurrentRegion.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("L:L").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=exportfile, FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWindow.Close
Selection.AutoFilter
Application.DisplayAlerts = True
Range("A7").Select
'email the data
mainemail = Range("f2").Value
Dim ol As Outlook.Application
Dim ns As Outlook.NameSpace
Dim newm As Outlook.MailItem
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
On Error Resume Next
Set newm = ol.CreateItem(olMailItem)
With newm
To = mainemail ' email address to send to
Subject = "Stats Return from " & exportname & "-" & exportmonth
' subject of the email
Body = "Here are is our Return" ' message in the email
With .Attachments.Add(exportfile) ' add the file i am using
at present
DisplayName = "Stats returns from " & exportplace
End With
Send
End With
Set ol = Nothing
Set ns = Nothing
Set newm = Nothing
MsgBox ("Your data has been exported to " & mainemail & ".")
End If
Sheets("data").Visible = True
End Sub
--
funkymonkUK
------------------------------------------------------------------------
funkymonkUK's Profile:
http://www.excelforum.com/member.php...o&userid=18135
View this thread:
http://www.excelforum.com/showthread...hreadid=538783