Hello Everyone,
I'm having an issue that I cant seem to resolve. Currently, my code sends an email out from Gmail when ran, but the attachment does not attach to the email. The attachment suppose to be a specified worksheet from the active workbook. I need to know why my code does not attach the worksheet I am trying to use, and need your help! Below I have copied the code that I have so far.
Dim NewMail As CDO.Message
Set NewMail = New CDO.Message
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copy the ActiveSheet to a new workbook
Sheets("PatientInfo").Select
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With
'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Patient Directive Sub. Form" & " " & Format(Now, "mmm-dd-yyyy")
'Enable SSL Authentication
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
'Make SMTP authentication Enabled=true (1)
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
'Set the SMTP server and port Details
'To get these details you can get on Settings Page of your Gmail Account
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Set your credentials of your Gmail Account
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = UsersEmail
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = UsersPassword
'Update the configuration fields
NewMail.Configuration.Fields.Update
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With NewMail
.Subject = "A PATIENT DIRECTIVE FORM HAS JUST BEEN SUBMITTED"
.From = UsersEmail
.To = "justin.ossai@healthport.com"
.CC = ""
.BCC = ""
.TextBody = "Attached is a copy of my submission"
.AddAttachment Destwb.FullName
NewMail.Send
End With
'On Error GoTo 0
.Close SaveChanges:=False
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
Set NewMail = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
I'm having an issue that I cant seem to resolve. Currently, my code sends an email out from Gmail when ran, but the attachment does not attach to the email. The attachment suppose to be a specified worksheet from the active workbook. I need to know why my code does not attach the worksheet I am trying to use, and need your help! Below I have copied the code that I have so far.
Dim NewMail As CDO.Message
Set NewMail = New CDO.Message
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copy the ActiveSheet to a new workbook
Sheets("PatientInfo").Select
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With
'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Patient Directive Sub. Form" & " " & Format(Now, "mmm-dd-yyyy")
'Enable SSL Authentication
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
'Make SMTP authentication Enabled=true (1)
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
'Set the SMTP server and port Details
'To get these details you can get on Settings Page of your Gmail Account
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Set your credentials of your Gmail Account
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = UsersEmail
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = UsersPassword
'Update the configuration fields
NewMail.Configuration.Fields.Update
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With NewMail
.Subject = "A PATIENT DIRECTIVE FORM HAS JUST BEEN SUBMITTED"
.From = UsersEmail
.To = "justin.ossai@healthport.com"
.CC = ""
.BCC = ""
.TextBody = "Attached is a copy of my submission"
.AddAttachment Destwb.FullName
NewMail.Send
End With
'On Error GoTo 0
.Close SaveChanges:=False
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
Set NewMail = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With