Access VBA causing system to crash

The code is not telling much

Just add an "error handler" so for example after every line you write down an entry to a Log table in order to get the  exact position where the crash occurs

I agree with John, add error handling throughout and see what gets reported back

Option Compare Database

Public Function Export_And_Email_Tables()
          Dim dbs                   As DAO.Database
          Dim tdf                   As DAO.TableDef
          Dim shell                 As Object
          Dim ZipFile               As Variant
10        Dim oFolder               As String: oFolder = Environ("USERPROFILE") & "\Documents\ArmsTracker_Export"
20        Dim oZipFile              As String: oZipFile = oFolder & "\ArmsTracker.zip"

30        On Error GoTo Error_Handler

40        If DirExists(oFolder) = False Then
50            createNewDirectory (oFolder)
60        End If

70        InitializeZipFile (oZipFile)
80        Set shell = CreateObject("Shell.Application")
90        ZipFile = oZipFile

100       Set dbs = CurrentDb

110       For Each tdf In dbs.TableDefs
120           If Left(tdf.Name, 4) <> "MSYS" Then
                  '/ output the table to a CSV file:
130               DoCmd.TransferText acExportDelim, , tdf.Name, oFolder & "_" & tdf.Name & ".csv", True
140               shell.namespace(ZipFile).copyhere (oFolder & "_" & tdf.Name & ".csv")
150               Do Until shell.namespace(ZipFile).items.Count >= 1
                      'Call gotosleep(100)
                      'Email one at a time
160               Loop
170           End If
180       Next tdf

190       EmailZippedFile (oZipFile)

Error_Handler_Exit:
200       On Error Resume Next
210       If Not shell Is Nothing Then Set shell = Nothing
220       If Not tdf Is Nothing Then Set tdf = Nothing
230       If Not dbs Is Nothing Then Set dbs = Nothing
240       Exit Function

Error_Handler:
250       MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
                 "Error Number: " & Err.Number & vbCrLf & _
                 "Error Source: Export_And_Email_Tables" & vbCrLf & _
                 "Error Description: " & Err.Description & _
                 Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
                 , vbOKOnly + vbCritical, "An Error has Occurred!"
260       Resume Error_Handler_Exit

End Function

Public Sub createNewDirectory(directoryName As String)
10        On Error GoTo Error_Handler

20        If Not DirExists(directoryName) Then
30            MkDir (directoryName)
40        End If

Error_Handler_Exit:
50        On Error Resume Next
60        Exit Sub

Error_Handler:
70        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
                 "Error Number: " & Err.Number & vbCrLf & _
                 "Error Source: createNewDirectory" & vbCrLf & _
                 "Error Description: " & Err.Description & _
                 Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
                 , vbOKOnly + vbCritical, "An Error has Occurred!"
80        Resume Error_Handler_Exit
End Sub

Function DirExists(DirName As String) As Boolean
10        On Error GoTo Error_Handler

20        DirExists = GetAttr(DirName) And vbDirectory

Error_Handler_Exit:
30        On Error Resume Next
40        Exit Function

Error_Handler:
50        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
                 "Error Number: " & Err.Number & vbCrLf & _
                 "Error Source: DirExists" & vbCrLf & _
                 "Error Description: " & Err.Description & _
                 Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
                 , vbOKOnly + vbCritical, "An Error has Occurred!"
60        Resume Error_Handler_Exit
End Function

Private Sub InitializeZipFile( _
        ZipFile As String _
        )
          Dim intFile               As Integer

10        On Error GoTo Error_Handler

20        If Len(Dir(ZipFile)) > 0 Then
30            Kill ZipFile
40        End If

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

Error_Handler_Exit:
90        On Error Resume Next
100       Exit Sub

Error_Handler:
110       MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
                 "Error Number: " & Err.Number & vbCrLf & _
                 "Error Source: InitializeZipFile" & vbCrLf & _
                 "Error Description: " & Err.Description & _
                 Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
                 , vbOKOnly + vbCritical, "An Error has Occurred!"
120       Resume Error_Handler_Exit
End Sub


Function EmailZippedFile(ByVal oZipFile As String) As Boolean
          Dim oEmailTo              As String
          Dim objOL                 As Object
          Dim olMail                As Object

10        On Error GoTo Error_Handler

20        oEmailTo = InputBox("Please enter email address", "Email Recipient(s)")

30        Set objOL = CreateObject("Outlook.Application")
40        Set olMail = objOL.createitem(0)

50        With olMail
60            .To = oEmailTo
              '.to = "murbro9@yahoo.com"
              '.to = "palpers@armedviolencereduction.org"
70            .Subject = "ArmsTracker Data"
80            .Attachments.Add (oZipFile)
              '.attachments.Add ("F:\Documents\TableDump\Tables.zip")
90            .send
100       End With

110       MsgBox "Data Sent"

Error_Handler_Exit:
120       On Error Resume Next
130       If Not olMail Is Nothing Then Set olMail = Nothing
140       If Not objOL Is Nothing Then Set objOL = Nothing
150       Exit Function

Error_Handler:
160       MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
                 "Error Number: " & Err.Number & vbCrLf & _
                 "Error Source: EmailZippedFile" & vbCrLf & _
                 "Error Description: " & Err.Description & _
                 Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
                 , vbOKOnly + vbCritical, "An Error has Occurred!"
170       Resume Error_Handler_Exit
End Function

Also, in lines

DoCmd.TransferText acExportDelim, , tdf.Name, oFolder & "_" & tdf.Name & ".csv", True

shell.namespace(ZipFile).copyhere (oFolder & "_" & tdf.Name & ".csv")

aren't you missing a \ instead of _, shouldn't it be

DoCmd.TransferText acExportDelim, , tdf.Name, oFolder & "\" & tdf.Name & ".csv", True

shell.namespace(ZipFile).copyhere (oFolder & "\" & tdf.Name & ".csv")

@Murray:
Unless you have a very valid Reason (like working with binary files), prefer using the FileSystemObject Library when dealing with the file system. It is far easyer to manipulate and more reliable.

@Daniel:
Unless it is within a top level function, error handlers should rethrow the error, else the calling function will never know something went wrong, thus they will continue processing with variables / object in an unknow state and effectivelly produce an undefined behavior.
Plus, most error handlers should remain silent, poping a message to the user is the sole responsibility of the top lvl functions.

@Fabrice,

Why don't you show us how it's done.

Normally, a function would return a True/False and with proper error handling this will indicate that it ran properly, or not, thus you can in calling procs continue, or not.  

No error while running your code on my PC.

Windows10

Office365/Access2016

You can run your code step by step via F8, then you will find out which line causing the error.

Please double check if ZIP/Outlook program installed