Popup to choose email recipients in VBA, also save to current user defined folder?

[MikeyW1969]

Hi all,
I have a project I'm building that currently works well. I have a list with multiple facilities, each on its own sheet, and I choose which one I'm getting a list for, it drops the rest, runs some code, saves in a predetermined folder on my computer, and sends an email.

The code for saving the file is(With XXX. YYY, ZZZ representing personal data):

 'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set DestWb = ActiveWorkbook
 
     TempFilePath = "C:\Users\XXXXX\Documents\YYYYY\ZZZZZZ\1 Year Checkups" & "\"
    'TempFileName = Format(Now, "yyyy-mm-dd hh-mm-ss") & Sourcewb.Name
    TempFileName = Sourcewb.Name & " 1 Year_" & Format(Now, "mm-dd-yy")
 
     With DestWb
        '.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=52
        .SaveAs TempFilePath & TempFileName & ".xlsm", FileFormat:=52
        '.Close SaveChanges:=False
    End With

I would like it to take the current user and save to a pre-made folder in their My Documents, all I need is how to have it just save to the user's My Documents, in a folder named the same as ZZZZZ(Which inside of YYYY, of course). It seems like the current user is something like %user%, is that correct?

My second one is hopefully easier. At the end, this document sends me an email(To my Gmail and work email), I would like to try and figure out how to have a popup to have the user choose any other recipients, and an spot to manually fill in an email address if needed. I don't mind hard-coding the email addresses for now, since there are only about 4 people who would use this at the moment. Right now, this is the code I have:

    Dim OutApp As Object    Dim OutMail As Object


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        .to = "XXXX@gmail.com"
        .CC = "YYYYYYY@ZZZZ.org"
        .BCC = ""
        .Subject = ActiveWorkbook.Name
        .Body = "Room Walkthrough"
        .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

Thanks in advance for any help!

 

[MikeyW1969]

OK, figured out the first part, but I see no option for editing. Here is the solution that I came up with, in case anyone else is interested. This saves to a specific folder inside of the 'My Documents' folder(Win 7 calls this just 'Documents', apparently. Besides cleaning up extra Comment lines, the only part I changed is the line in green.

    'Copy Creates New document named after sheet and saves in proper location    
    ActiveSheet.Copy
    Set DestWb = ActiveWorkbook
    
[COLOR=#008000]     TempFilePath = "C:\Users\" & Environ("Username") & "XXXXX\Teleservices\Room Walkthroughs\1 Year Checkups" & "\"[/COLOR]
     
    'TempFileName = Format(Now, "yyyy-mm-dd hh-mm-ss") & Sourcewb.Name
    TempFileName = Sourcewb.Name & " 1 Year_" & Format(Now, "mm-dd-yy")
 
     With DestWb
        '.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=52
        .SaveAs TempFilePath & TempFileName & ".xlsm", FileFormat:=52
        '.Close SaveChanges:=False
    End With