Situation:Vba to export tables as excel and email them (1 Viewer)

myezul

New member
Local time
Today, 07:18
Joined
Jan 8, 2015
Messages
4
Hello,

I have this code:
Code:
Private Sub Form_Close()

DoCmd.SetWarnings False
Dim file As String
Dim file2 As String
Dim file3 As String
Dim file4 As String
Dim path As String
path = InputBox("Save", "Export table")
Beep
MsgBox "Selectia va fi exportata in " & path

file = Forms![nomactiunifrm].[Produs] & Forms![nomactiunifrm].[Actiune] & ".xls"
file2 = Forms![nomactiunifrm].[Produs] & Forms![nomactiunifrm].[Actiune] & "_" & "Achitati2012" & ".xls"
file3 = Forms![nomactiunifrm].[Produs] & Forms![nomactiunifrm].[Actiune] & "_" & "Neachitati" & ".xls"
file4 = Forms![nomactiunifrm].[Produs] & Forms![nomactiunifrm].[Actiune] & "_" & "Potentiali" & ".xls"
If DCount("*", "Tmk_Achitati") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Tmk_Achitati", path + "\" + file, True
Else
End If
If DCount("*", "Tmk_Achitati<2012") > 0 Then
DoCmd.OpenQuery "x0ultimcodsSterg"
DoCmd.OpenQuery "x0ultimcodtmsSterg"
DoCmd.OpenQuery "x1ultimcodsId"
DoCmd.OpenQuery "x2ultimcods2"
DoCmd.OpenQuery "X3appendcodsachi_2012"
DoCmd.OpenQuery "X4updatecodsachi_2012"
DoCmd.OpenQuery "X5appendcodsachi_2012"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Tmk_Achitati<2012", path + "\" + file2, True
Else
End If
If DCount("*", "TMK_Neachitati") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "TMK_Neachitati", path + "\" + file3, True
Else
End If
If DCount("*", "TMK_Potentiali") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "TMK_Potentiali", path + "\" + file4, True
Else
End If

 

DoCmd.SetWarnings True

Exit Sub

End Sub
I use it to export tables, until now its all ok.
I want to use the path from the inputbox to attach the exported tables and send via email.

The email code is :
Code:
   DoCmd.SetWarnings False
    
    DoCmd.OpenQuery "_mailCC"
    DoCmd.OpenQuery "_Mailto"
    
    Dim rst As DAO.Recordset
    Dim rst1 As DAO.Recordset
    Dim Destinatar
    Dim CC
    Set rst = CurrentDb.OpenRecordset("MailTo")
    Do Until rst.EOF
    Destinatar = Destinatar & rst("mail") & ";"
    rst.MoveNext
    Loop
    
    Set rst1 = CurrentDb.OpenRecordset("MailCC")
    Do Until rst1.EOF
    CC = CC & rst1("Email") & ";"
    rst1.MoveNext
    Loop
    
    
    Dim mess_body As String, StrFile As String, strpath As String
    Dim appOutLook As Object
    Dim MailOutLook As Object
    Dim fd As FileDialog, Vrtseleteditem As Variant
    Dim mesaj As String
    
    mesaj = "Buna ziua," & vbCr & vbCr
    mesaj = mesaj & "Am atasat selectia pentru campania" & " " & Forms![nomactiunifrm].[Produs] & Forms![nomactiunifrm].[Actiune] & "." & vbCr & vbCr
    mesaj = mesaj & "O zi buna," & vbCr
    mesaj = mesaj & "Alex Topala" & vbCr
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
 

    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CREATEITEM(0)

    '~~> Change path here
    'strpath = InputBox("aLEGE FOLDER")

    With MailOutLook
        '.BodyFormat = olFormatRichText
        .To = Destinatar
        .CC = CC
        .Subject = Forms![nomactiunifrm].[Produs] & Forms![nomactiunifrm].[Actiune]
        .Body = mesaj

       If fd.Show = True Then
       For Each Vrtseleteditem In fd.SelectedItems
            .Attachments.Add Vrtseleteditem
            Next
            End If

        .recipients.resolveall
        '.DeleteAfterSubmit = True
        '.Send
         .DISPLAY
    End With

    MsgBox "Selectia a fost trimisa", vbOKOnly
End Sub
But i cant see how, could anybody give some pointers.
Thank you.
 

myezul

New member
Local time
Today, 07:18
Joined
Jan 8, 2015
Messages
4
Solved it.
Created a temp folder that contains the exported files and i attach them to the email after that i delete the temp folder.
 

Users who are viewing this thread

Top Bottom