can I send a file by email versus to a local desktop?

[daniels012]

In my code below I have this line of code

Case "TD"
strfilename = "\\Tomsblackibm\TomsProposals\" & strfilename

I would like to send this file by email if possible instead of to his computer. The user recently went from a desktop "in the office" to a laptop "all over the place".

Here is my code

Sub Save_and_SaveSalesman()


Dim strPath As String, strPath2 As String, CurrPath As String
    
    Dim WB1 As Workbook
    Dim WB2 As Workbook
        
    Set WB1 = ActiveWorkbook
    
    'First thing, save my work
    WB1.Save
    
    CurrPath = WB1.Path
    
    'ASSUMING THAT C6 and O3 are BOTH in WB1
    'move this line HERE: only do this once, and concatenate in the Select..Case later
    'doing thsi inside the Select..Case pulls values from WB2, which might cause errors...
    strfilename = Range("C6").Value & Range("O3").Value & ".xls"
    
    strPath = "C:\Documents and Settings\Owner\My Documents\Completed Proposals\"
    
    strPath2 = "C:\Documents and Settings\Owner\My Documents\Surface Systems\"
    
    On Error Resume Next
    
    'I then want to save my file as "Proposal" and the number in Cell O3
    WB1.SaveAs Filename:=strPath & strfilename
    
    On Error GoTo 0
    
    'I call this workbook "new_file"
    'as long as you use the WB1 object, you should not need to store the name... - PES
'    new_file = wb1.Name
    
    'you should never need to select anything... - PES
'    Range("F2").Select
    
    'I want to open "Proposal for XL" so I can make a 2nd copy to the salesmans computer
    Set WB2 = Workbooks.Open(Filename:=strPath2 & "Proposal for XL.xls")
    
    'I have to save the "new_file"
    'WHY??? you did this above - PES
'    Workbooks(new_file).Save
    
    'Workbooks(new_file).Close
    'Here is where i need to choose the computer for it to go to. As well as give the file a name that the salesman recognizes. C6 is customer name and O3 is the proposal number
    'Select Case WB2.Sheets("FRONT").Range("C2").Value
    Select Case WB1.Sheets("FRONT").Range("C2").Value
        Case "MD"
            strfilename = "\\MIKESRGATEWAY\MikesProposals\" & strfilename
            
        Case "TD"
            strfilename = "\\Tomsblackibm\TomsProposals\" & strfilename
            
        Case "DJ"
            strfilename = "\\DAVEJONES\DavesProposals\" & strfilename
            
        Case "CP"
            strfilename = "\\Chuckscomputer\daily\" & strfilename
            
    End Select
    
    WB1.SaveCopyAs Filename:=strfilename
    
    WB1.ActiveSheet.Shapes("Button 53").Visible = False
    
    ChDir CurrPath
    
    Application.ScreenUpdating = True
    
    WB1.Close
End Sub

Thank You,
Michael

 

[daniels012]

Well, no.
Can you give me a sample of where I can add send mail to the code I provided?
Thank You for your patience Norie, I am just green when it comes to this email stuff.

Michael

 

[daniels012]

OK, I have this:

Sub Save_and_SaveSalesman()
Dim strPath As String, strPath2 As String, CurrPath As String
    
    Dim WB1 As Workbook, WB2 As Workbook
    
    Set WB1 = ActiveWorkbook
    
    'First thing, save my work
    WB1.Save
    CurrPath = WB1.Path
    
    strfilename = Range("C6").Value & Range("O3").Value & ".xls"
    
    strPath = "C:\Documents and Settings\Owner\My Documents\Completed Proposals\"
    strPath2 = "C:\Documents and Settings\Owner\My Documents\Surface Systems\"
    
    On Error Resume Next
    
    'I then want to save my file as "Proposal" and the number in Cell O3
    WB1.SaveAs Filename:=strPath & strfilename
    
    On Error GoTo 0
    
    Set WB2 = Workbooks.Open(Filename:=strPath2 & "Proposal for XL.xls")
    
    Select Case WB1.Sheets("FRONT").Range("C2").Value
        Case "MD"
            strfilename = "\\MIKESRGATEWAY\MikesProposals\" & strfilename
            
        Case "TD"
            strfilename = "\\Tomsblackibm\TomsProposals\" & strfilename
            
        Case "DJ"
            strfilename = "\\DAVEJONES\DavesProposals\" & strfilename
            
        Case "CP"
            strfilename = "\\Chuckscomputer\daily\" & strfilename
            
    End Select
    
    WB1.SaveCopyAs Filename:=strfilename
    WB1.ActiveSheet.Shapes("Button 53").Visible = False
    ChDir CurrPath
    
    Application.ScreenUpdating = True
    
    WB1.Close
End Sub

I need to add this:

Dim OutApp As Object
    Dim OutMail As Object
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
        .Attachments.Add ActiveWorkbook.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0
 
    Set OutMail = Nothing
    Set OutApp = Nothing

Where can I put this? i won't need the cases anymore. Actually "To:" can be the value in cell S22

Thank you,
Michael