We help IT Professionals succeed at work.

Access VBA Email all tables as Excel spreadsheets

Murray Brown
Murray Brown asked
on
Hi

What Access VBA code would I use to automatically email all Access tables as Excel spreadsheets
via Outlook without the user being able to alter the data. So I want the emails to fire off straight away.

Thanks
Comment
Watch Question

View Solution Only

Rob HensonFinance Analyst
CERTIFIED EXPERT

Commented:
Any data when it has been separated from its source is open to amendment unless it is protected in some way.

I don't know how you do it but would suggest you create a Front End Viewer that you distribute to users. I believe a Front End Viewer enables users to view the data and/or reports without having access to the actual data so can't amend it.
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:

Do you mean you don't want them to alter the data in Access, or in the email?


If the latter, and you are attaching it as an Excel workbook, then you could protect that against modification with a password, etc.


»bp


Infotrakker Software
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014
Commented:

I believe he means the user sending the email cannot alter the data prior to it being sent?


If so, then you can loop through the tables and create a Zip file of all the tables, then attach that to the email. The code below has a couple of function:


ExportTables will export all the tables in your database and then create a Zip file and add all of them to the Zip.


EmailTables will email that zip file. You'd want to change the To address and the attachment path to ones suited to your situation.


The functions could certainly be tidied up, and you probably want to not hardcode the filepaths and such.


Function ExportTables()
Dim dbs As DAO.Database

Dim tdf As DAO.TableDef

Dim shell As Object
Dim ZipFile As Variant

InitializeZipFile ("F:\Documents\TableDump\Tables.zip")
Set shell = CreateObject("Shell.Application")
ZipFile = "F:\Documents\TableDump\Tables.zip"

Set dbs = CurrentDb

For Each tdf In dbs.TableDefs
    If Left(tdf.Name, 4) <> "MSYS" Then
        '/ output the table to a CSV file:
        DoCmd.TransferText acExportDelim, , tdf.Name, "F:\Documents\TableDump\" & tdf.Name & ".csv", True
        shell.namespace(ZipFile).copyhere ("F:\Documents\TableDump\" & tdf.Name & ".csv")
        Do Until shell.namespace(ZipFile).items.Count >= 1
            'Call gotosleep(100)
        Loop
    End If
Next tdf

Set shell = Nothing
Set tdf = Nothing
Set dbs = Nothing

End Function

Private Sub InitializeZipFile( _
  ZipFile As String _
)

Dim intFile As Integer

  If Len(Dir(ZipFile)) > 0 Then
    Kill ZipFile
  End If

  intFile = FreeFile
  Open ZipFile For Output As #intFile
  Print #intFile, Chr$(80) & Chr$(75) & _
    Chr$(5) & Chr$(6) & String(18, 0)
  Close #intFile
End Sub


Function EmailTables() As Boolean
Dim objOL As Object
Set objOL = CreateObject("Outlook.Application")

Dim olMail As Object
Set olMail = objOL.createitem(0)

With olMail
    .to = "youremail@youremail.com"
    .subject = "Email Test"
    .attachments.Add ("F:\Documents\TableDump\Tables.zip")
    .send
End With

Set olMail = Nothing
Set objOL = Nothing

End Function
Murray BrownASP.net/VBA/VSTO Developer

Author

Commented:
Hi Scott. Yes that is exactly what I needed.
Thank you very much