VBA code attach an excel file to outlook with a variable file path

[foxyginger]

At this point I have a MACRO which creates a new workbook, formatted for my needs, then saves that file using information from the cells within the worksheet. My next step that this MACRO also needs to do is to attach the newly created and saved file to an e-mail in outlook with a subject line and body, but no .To or .From information. This process will be in a Share drive meaning several people will be using this process, so it can't be personalized to one person. Currently the file is being saved to the individuals' M: drive (personal drive). My problem is that each time a new file is created it will have a different name, so I need the code to be able to vary file paths in finding the document.

This is my current code:


Option Explicit

Sub RunMACROandSaveAsCellContent()


Sheets("ETL").Select
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Cells.EntireColumn.AutoFit
Range("C7").Select
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "DATA"
Application.CutCopyMode = False


Dim Path As String
Dim FileName1 As String
Dim FileName2 As String


Path = "M:\"
FileName1 = Range("C3")
FileName2 = Format(Range("D3").Value, "mm-dd-yyyy")


ActiveWorkbook.SaveAs FileName:=Path & FileName1 & "_" & FileName2 & ".xlsx", FileFormat:=xlOpenXMLWorkbook


End Sub



This is what I've found for attaching documents to outlook:



Sub AttachmentOutlook()

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object


Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments


With OutLookMailItem
.To = "" 'want this left blank, it will change each time and is undetermined
.Subject = "ETL Wire Transfer Data"
.Body = "Hi!" & vbCrLf & "Attached is the ETL Wire Transfer Data File." & vbCrLf & "Thank you,"
myAttachments.Add "M:\" 'I'm unsure how to complete this file path when the file is changing each time
.Display


Set OutLookMailItem = Nothing
Set OutLookApp = Nothing


End Sub



As you can see from above, below is the file path I used to save the file as, now I need this to become the file path that the Outlook e-mail draws from:


Path = "M:\"FileName1 = Range("C3")
FileName2 = Format(Range("D3").Value, "mm-dd-yyyy")


ActiveWorkbook.SaveAs FileName:=Path & FileName1 & "_" & FileName2 & ".xlsx", FileFormat:=xlOpenXMLWorkbook

Thank you!

[mdmackillop]

Pass the value to the email sub



Dim FName as string
FName:=Path & FileName1 & "_" & FileName2 & ".xlsx"
ActiveWorkbook.SaveAs fname, FileFormat:=xlOpenXMLWorkbook
Call AttachmentOutlook(fname)
'etc.

Sub AttachmentOutlook(fname as string)
'as before
myAttachments.Add fname
'etc.

[mdmackillop]

I've tidied up the copy routine by simply copying the sheet to a new workbook, renaming and saving it. Step through the code so you can understand what is happening. I can't test this as I don't have Outlook running.


Option Explicit

Sub RunMACROandSaveAsCellContent()

Dim Path As String
Dim FileName1 As String
Dim FileName2 As String
Dim fname As String

Sheets("ETL").Copy
ActiveSheet.Name = "DATA"

Path = "M:\"
FileName1 = Range("C3")
FileName2 = Format(Range("D3").Value, "mm-dd-yyyy")

fname = Path & FileName1 & "_" & FileName2 & ".xlsx"
ActiveWorkbook.SaveAs fname, FileFormat:=xlOpenXMLWorkbook
Call AttachmentOutlook(fname)

End Sub


Sub AttachmentOutlook(fname As String)


Dim OutLookApp As Object
Dim OutLookMailItem As Object

Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)

With OutLookMailItem
.To = "" 'want this left blank, it will change each time and is undetermined
.Subject = "ETL Wire Transfer Data"
.Body = "Hi!" & vbCrLf & "Attached is the ETL Wire Transfer Data File." & vbCrLf & "Thank you,"
.AddAttachment fname
.Display
End With
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing


End Sub

[foxyginger]

I revised my code to run a different way and my new error is '438' on line
.AddAttachment fname


Full code below:



Sub RunAllMacros()
Procedure1
Procedure2
End Sub


Sub Procedure1()
Sheets("ETL").Select
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Cells.EntireColumn.AutoFit
Range("C7").Select
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "DATA"
Application.CutCopyMode = False


Dim Path As String
Dim FileName1 As String
Dim FileName2 As String


Path = "M:\"
FileName1 = Range("C3")
FileName2 = Format(Range("D3").Value, "mm-dd-yyyy")


ActiveWorkbook.SaveAs FileName:=Path & FileName1 & "_" & FileName2 & ".xlsx", FileFormat:=xlOpenXMLWorkbook
End Sub


Sub Procedure2()
Dim OutLookApp As Object
Dim OutLookMailItem As Object


Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)


With OutLookMailItem
.To = ""
.Subject = "ETL Wire Transfer Data"
.Body = "Hi!" & vbCrLf & "Attached is the ETL Wire Transfer Data File." & vbCrLf & "Thank you,"
.AddAttachment fname 'Run-time error '438': Object doesn't support this property or method
.Display
End With


Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub

[mdmackillop]

This uses a Public variable set at the head of the module. The value is set by the first sub and used by the second.


Dim AttFile As String


Sub RunAllMacros()
Procedure1
Procedure2
End Sub

Sub Procedure1()
Sheets("ETL").Copy
ActiveSheet.Name = "DATA"

Dim Path As String
Dim FileName1 As String
Dim FileName2 As String


Path = "M:\"
FileName1 = Range("C3")
FileName2 = Format(Range("D3").Value, "mm-dd-yyyy")

AttFile = Path & FileName1 & "_" & FileName2 & ".xlsx"
ActiveWorkbook.SaveAs Filename:=AttFile, FileFormat:=xlOpenXMLWorkbook
End Sub


Sub Procedure2()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object

Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments
With OutLookMailItem
.TO = ""
.Subject = "ETL Wire Transfer Data"
.body = "Hi!" & vbCrLf & "Attached is the ETL Wire Transfer Data File." & vbCrLf & "Thank you,"
myAttachments.Add AttFile
.display
End With
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub

[foxyginger]

This sadly produces the same error. :crying:

[mdmackillop]

OK I installed Outlook to test and amended the above code in post #5 to correct the errors.

[foxyginger]

AHHHH IT WORKS!!! :) YAY! :cloud9: :clap: :thumb :friends: :bow: :beerchug:

Thank you so much!