Save Email to Directory (1 Viewer)

J

johankotze

Registered User.
Local time
Today, 08:31
Joined
Jul 3, 2016
Messages
54
I found very old post in this forum - 2005, started by Ang. Tried to implement the code but can't get it to work

Code: 
Private Sub AmendmentInsurer_Click()
'Dim Variable_Note  As String
    Dim stDocName       As String
    Dim MyPath          As String
    Dim MyFileName      As String
    Dim Variable_To     As String
    Dim Variable_CC     As String
    Dim Variable_Subject As String
    Dim Variable_Body   As String
    Dim Signature       As String
    Dim OutApp          As Object
    Dim OutMail         As Object
    Dim OutlookAttach   As Outlook.Attachment
    Dim strFileName     As String
   
    'I place the file on a different folder
    '-------------------------------------------------------
     MyPath = "\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Amendments\"

    'State the filename.
    '-------------------------------------------------------
    MyFileName = "Amendment" & "" & "nr_" & Me.Amendment_nr & " " & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title

    'Let's print and save. Once you see it works, you can change True to False so that the file created is not opened after completion.
    '----------------------------------------------------------------------------------------------------------------------------------
    DoCmd.OpenReport "AmendmentPersonalSend", acViewPreview
    DoCmd.OutputTo acOutputReport, "AmendmentPersonalSend", acFormatPDF, MyPath & MyFileName & ".pdf", False   'True
   
    'Let's close our previewed report
    '--------------------------------
    'DoCmd.Close acReport, "AmendmentPersonalSend"

    ' The filepath for the attachment
    '--------------------------------
    If Not IsNull(Me.strHyperlink) Then
    strFileName = Mid$(Me.strHyperlink, InStr(Me.strHyperlink, "#") + 1)
    Else
    strFileName = "Empty"
    End If

    'Set Variables
    '---------------------------
    Variable_To = Me.EmailTo
    Variable_CC = Me.Text61 & ";" & Me.Text97
    Variable_Subject = Me.Text32 & "/" & Me.Text36 & " " & Me.Text35 & " " & Me.Text34 & " - Service#: " & Amendment_nr
       
    Variable_Body = "<FONT face=Verdana size=2><B>CLIENT: </B>" & Me.Text82 & " " & Me.Text35 & " " & Me.Text34 & "<BR>"
    Variable_Body = Variable_Body & "<B>INSURER: </B>" & Me.Text41 & "<BR>"
    Variable_Body = Variable_Body & "<B>POLICY#: </B>" & Me.Text32 & "<BR>"
    Variable_Body = Variable_Body & "<B>SERVICE#:</B> <font color=red>" & Me.Amendment_nr & "</font><BR>"
    Variable_Body = Variable_Body & "<B>AMENDMENT DATE:</B> " & Me.AmendDate & "<BR>"
   
    Variable_Body = Variable_Body & "<CENTER><B>INSTRUCTION TO INSURER</B></CENTER>" & "<BR>"
   
    Variable_Body = Variable_Body & "<hr style= 'color:Red;height:2pt;width:100%;' />"
    Variable_Body = Variable_Body & Me.Amendment
    Variable_Body = Variable_Body & "<hr style= 'color:Red;height:1pt;width:100%;' />"
    Variable_Body = Variable_Body & "Groete/Regards<BR>"
                     
    'Set the ATTACHMENT field
    '--------------------------------------------------------------------------------------
    'If Not IsNull(strHyperlink) Then
    'OutlookMail.Attachments.Add (strFileName)
    'End If

    'Set Outlook session with signature
    '-----------------------------------------------
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail                               ' This creates a blank email and captures the users default signature.
        .BodyFormat = 2                        ' 2 = HTML format
        .Send                    'or use .Display
    End With

    Signature = OutMail.HTMLBody

    With OutMail

        .To = Variable_To
        .CC = Variable_CC
        .BCC = ""
        .Subject = Variable_Subject
        .Attachments.Add (MyPath & MyFileName & ".pdf")
        .Attachments.Add (strFileName)
        .HTMLBody = Variable_Body & Signature
        .SaveAs = """\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Send Emails\" & Variable_Subject & ".msg", OlSaveAsType.olMSG"""
        .Display                              'or use .Send
        .ReadReceiptRequested = True
    End With
    MsgBox "The Email has been send successfully to" & " " & Me.EmailTo
   
    'Call Client confirmation
    '------------------------
    Call AmendConfir_Click
   
End Sub

I keep getting the error in red at the .SaveAs line
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:31
Joined
May 7, 2009
Messages
19,243
maybe:

.SaveAs "\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Send Emails\" & Variable_Subject & ".msg", OlSaveAsType.olMSG
 
Isaac

Isaac

Lifelong Learner
Local time
Yesterday, 22:31
Joined
Mar 14, 2017
Messages
8,777
What error?
 
J

johankotze

Registered User.
Local time
Today, 08:31
Joined
Jul 3, 2016
Messages
54
arnelgp said:
maybe:

.SaveAs "\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Send Emails\" & Variable_Subject & ".msg", OlSaveAsType.olMSG
Click to expand...
Thx Arnelgp
For the prompt reply but above code still don't save the email. Might be a code somewhere beginning of the whole code.
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:31
Joined
May 7, 2009
Messages
19,243
on the .SaveAs filename, "My Documents", i think should be modified to "Documents".
unless the folder/subfolder exists on the Path, it will not get saved.
therefore, you need a code that will actually Create a folder first before
you can save it to that folder.

also Variable_Subject, which is also used in building your Path (in .SaveAs) has dash (-) and colon : on it
which is Not allowed character on creating a folder.
 
J

johankotze

Registered User.
Local time
Today, 08:31
Joined
Jul 3, 2016
Messages
54
arnelgp said:
on the .SaveAs filename, "My Documents", i think should be modified to "Documents".
unless the folder/subfolder exists on the Path, it will not get saved.
therefore, you need a code that will actually Create a folder first before
you can save it to that folder.

also Variable_Subject, which is also used in building your Path (in .SaveAs) has dash (-) and colon : on it
which is Not allowed character on creating a folder.
Click to expand...
The Sent Emails sub directory (not Send Emails I did made the typing mistake) is create when a the client is added to the database.
I changed Variable_Subject line to Amendment_nr which forms part of the Variable_Subject.

So I changed the .SaveAs as follows
Code: 
.SaveAs "\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Sent Emails\" & Me.Amendment_nr & ".msg", OlSaveAsType.olMSG
Code: 
.Send
The above is working but how do I add Date & Time to .SaveAs line
 
Last edited:
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:31
Joined
May 7, 2009
Messages
19,243
firstly, try creating a folder with a dash (-) or colon : in it.
then try it with file name if you can create with colon.
 
J

johankotze

Registered User.
Local time
Today, 08:31
Joined
Jul 3, 2016
Messages
54
Isaac said:
What error?
Click to expand...
Isaac
I change the Variable_Subject in the .SaveAs line to Me.Amendment_nr which form part of Variable_Subject and the email get saved now. Now I need to figure out how to add a Date & Time stamp as part of the saved email name
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 06:31
Joined
Sep 21, 2011
Messages
14,299
johankotze said:
Isaac
I change the Variable_Subject in the .SaveAs line to Me.Amendment_nr which form part of Variable_Subject and the email get saved now. Now I need to figure out how to add a Date & Time stamp as part of the saved email name
Click to expand...
Just use the Format() function.
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:31
Joined
May 7, 2009
Messages
19,243
this will add the date and time (yyyy_mm_dd_hh_nn_ss) at the end (before the extension):
Code: 
.SaveAs "\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Sent Emails\" & Me.Amendment_nr & "_" & Format$(Now(), "yyyy_mm_dd_hh_nn_ss") & ".msg", OlSaveAsType.olMSG
 
Isaac

Isaac

Lifelong Learner
Local time
Yesterday, 22:31
Joined
Mar 14, 2017
Messages
8,777
johankotze said:
Isaac
I change the Variable_Subject in the .SaveAs line to Me.Amendment_nr which form part of Variable_Subject and the email get saved now. Now I need to figure out how to add a Date & Time stamp as part of the saved email name
Click to expand...
Always provide which VBA error (nbr & description) when asking help
 
J

johankotze

Registered User.
Local time
Today, 08:31
Joined
Jul 3, 2016
Messages
54
Thx Arnelgp & Isaac a lot code is working.
Just one last thing. How can I go about at the .SaveAs line if the sub directory Sent Emails does for instance not exists how can it then be created and save the email
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:31
Joined
May 7, 2009
Messages
19,243
you create this sub (together with your button code):
Code: 
Private Sub ForceMKDir(ByVal thePath As String)
    Const prefix As String = "\\"
    Dim var As Variant, s As String
    Dim i As Integer
    
    If Left$(thePath, 2) = prefix Then
        thePath = Mid$(thePath, 3)
    End If
    
    var = Split(thePath, "\")
    
    On Error Resume Next
    
    s = prefix
    For i = 0 To UBound(var)
    
        s = s & var(i)
        VBA.MkDir s
        s = s & "\"
        
    Next i
    
End Sub

before saving, create the folder first:

Code: 
'Create the folder
Call ForceMkDir("\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Sent Emails")
.SaveAs "\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Sent Emails\" & Me.Amendment_nr & "_" & Format$(Now(), "yyyy_mm_dd_hh_nn_ss") & ".msg", OlSaveAsType.olMSG
 
J

johankotze

Registered User.
Local time
Today, 08:31
Joined
Jul 3, 2016
Messages
54
arnelgp said:
you create this sub (together with your button code):
Code: 
Private Sub ForceMKDir(ByVal thePath As String)
    Const prefix As String = "\\"
    Dim var As Variant, s As String
    Dim i As Integer
   
    If Left$(thePath, 2) = prefix Then
        thePath = Mid$(thePath, 3)
    End If
   
    var = Split(thePath, "\")
   
    On Error Resume Next
   
    s = prefix
    For i = 0 To UBound(var)
   
        s = s & var(i)
        VBA.MkDir s
        s = s & "\"
       
    Next i
   
End Sub

before saving, create the folder first:

Code: 
'Create the folder
Call ForceMkDir("\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Sent Emails")
.SaveAs "\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Sent Emails\" & Me.Amendment_nr & "_" & Format$(Now(), "yyyy_mm_dd_hh_nn_ss") & ".msg", OlSaveAsType.olMSG
Click to expand...
Thx Arnelgp for all you're appreciated help.
I will give it a go. As I under I need to create a button for the sub ForceMKDir then call it from send button before the .SaveAs code
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:31
Joined
May 7, 2009
Messages
19,243
johankotze said:
As I under I need to create a button for the sub ForceMKDir then call it from send button
Click to expand...
no, you don't need to create any button.

just put the ForceMKDir sub a the end of your code (where AmendmentInsurer_Click() is).
then insert the Code in post #13 (right before .SaveAs ...)
 
E

ebs17

Well-known member
Local time
Today, 07:31
Joined
Feb 7, 2020
Messages
1,946
This function creates a complete directory path including subfolders that do not yet exist.
Code: 
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
  ByVal  lpPath As String) As Long
Code: 
Sub test_MSDPE()
    Dim sPath As String
    sPath = "C:\wonderful\newday\inholydays\"
    MakeSureDirectoryPathExists sPath
End Sub
 
J

johankotze

Registered User.
Local time
Today, 08:31
Joined
Jul 3, 2016
Messages
54
arnelgp said:
no, you don't need to create any button.

just put the ForceMKDir sub a the end of your code (where AmendmentInsurer_Click() is).
then insert the Code in post #13 (right before .SaveAs ...)
Click to expand...
Arnelgp something like this
Code: 
Private Sub ForceMKDir(ByVal thePath As String)
    Const prefix As String = "\\"
    Dim var As Variant, s As String
    Dim i As Integer
    
    If Left$(thePath, 2) = prefix Then
        thePath = Mid$(thePath, 3)
    End If
    
    var = Split(thePath, "\")
    
    On Error Resume Next
    
    s = prefix
    For i = 0 To UBound(var)
    
        s = s & var(i)
        VBA.MkDir s
        s = s & "\"
        
    Next i
    
End Sub

Code: 
Private Sub AmendmentInsurer_Click()
'Dim Variable_Note  As String
    Dim stDocName       As String
    Dim MyPath          As String
    Dim MyFileName      As String
    Dim Variable_To     As String
    Dim Variable_CC     As String
    Dim Variable_Subject As String
    Dim Variable_Body   As String
    Dim Signature       As String
    Dim OutApp          As Object
    Dim OutMail         As Object
    Dim OutlookAttach   As Outlook.Attachment
    Dim strFileName     As String
  
    'I place the file on a different folder
    '-------------------------------------------------------
     MyPath = "\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Amendments\"

    'State the filename.
    '-------------------------------------------------------
    MyFileName = "Amendment" & "" & "nr_" & Me.Amendment_nr & " " & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title

    'Let's print and save. Once you see it works, you can change True to False so that the file created is not opened after completion.
    '----------------------------------------------------------------------------------------------------------------------------------
    DoCmd.OpenReport "AmendmentPersonalSend", acViewPreview
    DoCmd.OutputTo acOutputReport, "AmendmentPersonalSend", acFormatPDF, MyPath & MyFileName & ".pdf", False   'True
  
    'Let's close our previewed report
    '--------------------------------
    DoCmd.Close acReport, "AmendmentPersonalSend"

    ' The filepath for the attachment
    '--------------------------------
    If Not IsNull(Me.strHyperlink) Then
    strFileName = Mid$(Me.strHyperlink, InStr(Me.strHyperlink, "#") + 1)
    Else
    strFileName = "Empty"
    End If

    'Set Variables
    '---------------------------
    Variable_To = Me.EmailTo
    Variable_CC = Me.Text61 & ";" & Me.Text97
    Variable_Subject = Me.Text32 & "/" & Me.Text36 & " " & Me.Text35 & " " & Me.Text34 & " - Service#: " & Amendment_nr
      
    Variable_Body = "<FONT face=Verdana size=2><B>CLIENT: </B>" & Me.Text82 & " " & Me.Text35 & " " & Me.Text34 & "<BR>"
    Variable_Body = Variable_Body & "<B>INSURER: </B>" & Me.Text41 & "<BR>"
    Variable_Body = Variable_Body & "<B>POLICY#: </B>" & Me.Text32 & "<BR>"
    Variable_Body = Variable_Body & "<B>SERVICE#:</B> <font color=red>" & Me.Amendment_nr & "</font><BR>"
    Variable_Body = Variable_Body & "<B>AMENDMENT DATE:</B> " & Me.AmendDate & "<BR>"
  
    Variable_Body = Variable_Body & "<CENTER><B>INSTRUCTION TO INSURER</B></CENTER>" & "<BR>"
  
    Variable_Body = Variable_Body & "<hr style= 'color:Red;height:2pt;width:100%;' />"
    Variable_Body = Variable_Body & Me.Amendment
    Variable_Body = Variable_Body & "<hr style= 'color:Red;height:1pt;width:100%;' />"
    Variable_Body = Variable_Body & "Groete/Regards<BR>"
                    
    'Set the ATTACHMENT field
    '--------------------------------------------------------------------------------------
    'If Not IsNull(strHyperlink) Then
    'OutlookMail.Attachments.Add (strFileName)
    'End If

    'Set Outlook session with signature
    '-----------------------------------------------
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail                               ' This creates a blank email and captures the users default signature.
        .BodyFormat = 2                        ' 2 = HTML format
        .Display                  'or use .Send
    End With

    Signature = OutMail.HTMLBody

    With OutMail

        .To = Variable_To
        .CC = Variable_CC
        .BCC = ""
        .Subject = Variable_Subject
        .Attachments.Add (MyPath & MyFileName & ".pdf")
        .Attachments.Add (strFileName)
        .HTMLBody = Variable_Body & Signature
        
       'Create the folder
     Call ForceMkDir("\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Sent Emails")
        .SaveAs "\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Sent Emails\" & Me.Amendment_nr & "_" & Format$(Now(), "dd_mm_yyyy_hh_nn_ss") & ".msg", OlSaveAsType.olMSG
                  
        .Display                           'or use .Send
        .ReadReceiptRequested = True
    End With
    MsgBox "The Email has been send successfully to" & " " & Me.EmailTo
  
    'Call Client confirmation
    '------------------------
    Call AmendConfir_Click
  
End Sub
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:31
Joined
May 7, 2009
Messages
19,243
are they on same module, it should be like this:
Code: 
Private Sub AmendmentInsurer_Click()
'Dim Variable_Note  As String
    Dim stDocName       As String
    Dim MyPath          As String
    Dim MyFileName      As String
    Dim Variable_To     As String
    Dim Variable_CC     As String
    Dim Variable_Subject As String
    Dim Variable_Body   As String
    Dim Signature       As String
    Dim OutApp          As Object
    Dim OutMail         As Object
    Dim OutlookAttach   As Outlook.Attachment
    Dim strFileName     As String
 
    'I place the file on a different folder
    '-------------------------------------------------------
     MyPath = "\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Amendments\"

    'State the filename.
    '-------------------------------------------------------
    MyFileName = "Amendment" & "" & "nr_" & Me.Amendment_nr & " " & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title

    'Let's print and save. Once you see it works, you can change True to False so that the file created is not opened after completion.
    '----------------------------------------------------------------------------------------------------------------------------------
    DoCmd.OpenReport "AmendmentPersonalSend", acViewPreview
    DoCmd.OutputTo acOutputReport, "AmendmentPersonalSend", acFormatPDF, MyPath & MyFileName & ".pdf", False   'True
 
    'Let's close our previewed report
    '--------------------------------
    DoCmd.Close acReport, "AmendmentPersonalSend"

    ' The filepath for the attachment
    '--------------------------------
    If Not IsNull(Me.strHyperlink) Then
    strFileName = Mid$(Me.strHyperlink, InStr(Me.strHyperlink, "#") + 1)
    Else
    strFileName = "Empty"
    End If

    'Set Variables
    '---------------------------
    Variable_To = Me.EmailTo
    Variable_CC = Me.Text61 & ";" & Me.Text97
    Variable_Subject = Me.Text32 & "/" & Me.Text36 & " " & Me.Text35 & " " & Me.Text34 & " - Service#: " & Amendment_nr
      
    Variable_Body = "<FONT face=Verdana size=2><B>CLIENT: </B>" & Me.Text82 & " " & Me.Text35 & " " & Me.Text34 & "<BR>"
    Variable_Body = Variable_Body & "<B>INSURER: </B>" & Me.Text41 & "<BR>"
    Variable_Body = Variable_Body & "<B>POLICY#: </B>" & Me.Text32 & "<BR>"
    Variable_Body = Variable_Body & "<B>SERVICE#:</B> <font color=red>" & Me.Amendment_nr & "</font><BR>"
    Variable_Body = Variable_Body & "<B>AMENDMENT DATE:</B> " & Me.AmendDate & "<BR>"
 
    Variable_Body = Variable_Body & "<CENTER><B>INSTRUCTION TO INSURER</B></CENTER>" & "<BR>"
 
    Variable_Body = Variable_Body & "<hr style= 'color:Red;height:2pt;width:100%;' />"
    Variable_Body = Variable_Body & Me.Amendment
    Variable_Body = Variable_Body & "<hr style= 'color:Red;height:1pt;width:100%;' />"
    Variable_Body = Variable_Body & "Groete/Regards<BR>"
                    
    'Set the ATTACHMENT field
    '--------------------------------------------------------------------------------------
    'If Not IsNull(strHyperlink) Then
    'OutlookMail.Attachments.Add (strFileName)
    'End If

    'Set Outlook session with signature
    '-----------------------------------------------
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail                               ' This creates a blank email and captures the users default signature.
        .BodyFormat = 2                        ' 2 = HTML format
        .Display                  'or use .Send
    End With

    Signature = OutMail.HTMLBody

    With OutMail

        .To = Variable_To
        .CC = Variable_CC
        .BCC = ""
        .Subject = Variable_Subject
        .Attachments.Add (MyPath & MyFileName & ".pdf")
        .Attachments.Add (strFileName)
        .HTMLBody = Variable_Body & Signature
        
       'Create the folder
     Call ForceMKDir("\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Sent Emails")
        .SaveAs "\\JK_Server-PC\Users\JK_Server\My Documents\JKBrokers\Clients\PersonalClients\" & Forms!ClientInformation.LastName & " " & Forms!ClientInformation.Initials & " " & Forms!ClientInformation.Title & "_" & Forms!ClientInformation.ClientNr & "\Sent Emails\" & Me.Amendment_nr & "_" & Format$(Now(), "dd_mm_yyyy_hh_nn_ss") & ".msg", OlSaveAsType.olMSG
                  
        .Display                           'or use .Send
        .ReadReceiptRequested = True
    End With
    MsgBox "The Email has been send successfully to" & " " & Me.EmailTo
 
    'Call Client confirmation
    '------------------------
    Call AmendConfir_Click
 
End Sub


Private Sub ForceMKDir(ByVal thePath As String)
    Const prefix As String = "\\"
    Dim var As Variant, s As String
    Dim i As Integer
    
    If Left$(thePath, 2) = prefix Then
        thePath = Mid$(thePath, 3)
    End If
    
    var = Split(thePath, "\")
    
    On Error Resume Next
    
    s = prefix
    For i = 0 To UBound(var)
    
        s = s & var(i)
        VBA.MkDir s
        s = s & "\"
        
    Next i
    
End Sub
 
J

johankotze

Registered User.
Local time
Today, 08:31
Joined
Jul 3, 2016
Messages
54
Thx Arnelgp, the code is working perfect

Just run in a bit head scratching on the AmendmentDetails subform in the control EmailCC. Sometimes one needs to add more than one CC email. So if needed I want to select more then one email address in the EmailCC (combo box control). Like in Outlook where one can add multiple email address in CC.

EmailCC Control proprties below
Control Source is Email
Row Source is SELECT Email FROM tblInsContactDetails ORDER BY Email;
Row Source Type is Table/Query
Bound Column: 1
Limited to List: No
As currently I can only select one email address.
 
You must log in or register to reply here.

Similar threads

M
Add Signature to Email body
Replies
2
Views
752
Momma
M
M
Solved VBA access to outlook email with table: aligning table cells
Replies
5
Views
1,899
miacino
M
M
Email to include Outlook signature
Replies
8
Views
822
sxschech
S
S
how to send email from another account
Replies
2
Views
1,260
smiler44
S
W
Adding an attachment to email
Replies
4
Views
1,505
wllsth
W

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom