Macro to save workbook to user desktop and email attachment

Re: Macro to save workbook to user desktop and email attachm

lilFajita, I changed your .saveas line (make sure to edit for your desktop location) and the fname assignment line (you were missing the "\").

This is a great site for sending email using excel:
http://www.rondebruin.nl/sendmail.htm


Public Sub XXX()
FileName = InputBox("Deal name Please")
ActiveWorkbook.SaveAs FileName:="C:\WINNT\Profiles\BGates\Desktop\" & "CLOSED DEAL_" & FileName
'ThisWorkbook.SaveAs (Environ("userprofile") & Application.PathSeparator & "Desktop" & Application.PathSeparator & "CLOSED DEAL_" & FileName)

Dim myOutlook As Object
Dim myMailItem As Object


Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(olMailItem)
fname = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

With otlNewMail
.To = "me@me.com"
.Subject = "Closed Deal File for " & FileName
.Body = "Attached is the File for " & FileName
.Attachments.Add fname
.Display

End With


Set otlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
Set otlMess = Nothing
Set otlNSpace = Nothing

End Sub

Re: Macro to save workbook to user desktop and email attachm

Marc- thanks for the reply!

onee question: if I put in this line, with my profile name:

ActiveWorkbook.SaveAs FileName:="C:\WINNT\Profiles\BGates\Desktop\" & "CLOSED DEAL_" & FileName

will it still work on other people's profiles/computers? This spreadsheet will be out on the intranet, and so people will be using their own computers to access it. I just didn't understand that part.

Thanks!

Re: Macro to save workbook to user desktop and email attachm

Hola lilFajita, Turns out your code was fine except for the missing "\" in your code. I just digested the Environ("userprofile") bit of code (neat). Please revert back to your original code.

Re: Macro to save workbook to user desktop and email attachm

I'm working on a project much like this

Dim fname
fname = "C:\Documents and Settings\" & txtacf2.Value & "\my documents\" & Txtname.Value & " " & txtsuppliername.Value & ".xls"
Set newbook = Workbooks.Add
newbook.SaveAs Filename:=fname

txtacf2 is the users id (every user in my company has an id, they are required to enter it on the form i've created). Txtname is from the form and txtsuppliername is again from the form. The user must fill these fields in before they can save.

If the user enters the wrong acf2 into the system, it wont find the folder. I get an error 1004. How can i change the error output message to display some sort of text ... example "you've entered your ACF2 in wrong you nitwit, go back and fix it!" then have excel kick back to the user form so they can correct it...

Any ideas?

Thanks



mr. alex

Re: Macro to save workbook to user desktop and email attachm

Mr. Alex, Why not take away the responsibility of entering the user id from the user.

Check this out:

Public Sub kkkk()
MsgBox Environ("userprofile")
MsgBox Environ("username")
End Sub

Will this modification to your code work?

Dim fname
fname = "C:\Documents and Settings\" & Environ("username") & "\my documents\" & Txtname.Value & " " & txtsuppliername.Value & ".xls"
Set newbook = Workbooks.Add
newbook.SaveAs FileName:=fname

Re: Macro to save workbook to user desktop and email attachm

wow.

Thanks!

"May the fruit of your loins bring you much happiness!"

Mr Alex

Re: Macro to save workbook to user desktop and email attachm

wow- thanks for your help Marc! I found all that code on this board.

one question: how hard would it be to allow the user to pick the save location? So, when the macro runs, it pulls up a save as box with the name populated, and the user can navigate to the location they want. Is that possible?

Re: Macro to save workbook to user desktop and email attachm

Sub Perstats()
'Working in 2000-2010
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Range("O5:W15").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "" & Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "xxxxxxxxxxxx@gmail.com"
.CC = ""
.BCC = ""
.Subject = "2-357th Perstats"
.Body = ""
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\desktop\Misc Excel Docs")
.Display 'or use .Send
End With
On Error GoTo 0
.Close savechanges:=True
End With
End Sub

can you help me with this. when i send this email then i want to save the attachment to a folder on the desktop by the date.

Re: Macro to save workbook to user desktop and email attachm

how can i use this in my macro? it is poseted below.