Predefined "Save as"

[Ildestino]

Hey there!

Well Im having this issue, bout the VBA code that I wrote. Id like to include a predefined "Save as" whenever a user hits the "Save and Send button". I have like many users with different user profiles and Id like to user "My Documents" as predefined saving path.

Id be really really thankful if you can help me out with this one.

Kind regards

Ildestino


Sub SendGenericDocumentMail_PIR()
Application.Dialogs(xlDialogSaveAs).Show "DRF 16 Material " & Range("C34").Value
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 = "E-Mail adress"
.CC = ""
.BCC = ""
.Subject = "New Material" & " " & Range("E19").Value & " " & "Request" & " - " & Range("C34").Value
.Body = "Dear MDM Team, attached please find a material request. Kind regards"

.Attachments.Add ActiveWorkbook.FullName
.Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

[Bob Phillips]

Sub SendGenericDocumentMail_PIR()
Dim OutApp As Object
Dim OutMail As Object
Dim fname As String
Dim path As String

path = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
With Application.FileDialog(msoFileDialogSaveAs)

.AllowMultiSelect = False
.InitialFileName = path & Application.PathSeparator & "DRF 16 Material " & Range("C34").Value
If .Show = -1 Then

ActiveWorkbook.SaveAs .SelectedItems(1)
End If
End With

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

On Error Resume Next
With OutMail
.To = "E-Mail adress"
.CC = ""
.BCC = ""
.Subject = "New Material" & " " & Range("E19").Value & " " & "Request" & " - " & Range("C34").Value
.Body = "Dear MDM Team, attached please find a material request. Kind regards"

.Attachments.Add ActiveWorkbook.FullName
.Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

[snb]

sub M_snb()
ActiveWorkbook.SaveAs CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\DRF 16 Material " & Range("C34").Value & ".xlsx",51

with CreateObject("Outlook.Application").CreateItem(0)
.To = "EMail@address"
.Subject = "New Material" & " " & Range("E19").Value & " " & "Request" & " - " & Range("C34").Value
.Body = "Dear MDM Team, attached please find a material request. Kind regards"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
end sub

[Ildestino]

Thank you guys for the response!!! :)

Trouble with this excel file is that it has to be stored in a sharepoint server, which I only have the read and write access. Users can access the file, but it always re route to the sharepoint path instead on they My documents. Is there any way to fix it?

[snb]

You are the only one who is familiar with the sharepoint path.
You can replace the CreateObject("WScript.Shell").SpecialFolders("MyDocuments") path by that sharepoint path.