Public Sub ExportFile()
DoCmd.SetWarnings False
Dim db As Database
Dim strFileName As String
Dim dFileDate As Date
Set db = CurrentDb()
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Dim rec As Recordset
Set db = CurrentDb
'***************************************************************
Msg = "Do you want to export? Do you wish to continue?"
Style = vbYesNo + vbWarning + vbDefaultButton2
Title = ""
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.
MyString = "Yes" ' Perform some action.
DoCmd.SetWarnings False
On Error GoTo ErrorHandler
'***************************************************************
outputFileName = "J:\MyFile_" & Format(Date, "YYYYMMdd") & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "MyReport", outputFileName, True
'***************************************************************
DoCmd.SetWarnings True
MsgBox "The report has been exported"
Exit Sub
ErrorHandler:
MsgBox "There was an Error: " & Err & ": " & Error(Err)
Else ' User chose No.
MyString = "No" ' Perform some action.
End If
End Sub
‘VBA Code to export an Access table to an Excel file with a date extension
‘This is my example. The paths and names should be changed for your project.
‘Just put the code behind a command button on a form.
Private Sub Command52_Click()
On Error GoTo Error_Handler
'***************************************************************
DoCmd.RunMacro "MyStoredMacro"
'***************************************************************
Error_Handler_Exit:
On Error Resume Next
Exit Sub
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Command52_Click" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, _
"An Error has Occured!"
Resume Error_Handler_Exit
‘VBA Code to run a macro.
‘This is my example.
‘Just put the code behind a command button on a form and change the command button name.
' Purpose : Loop through tables and fields, and trim text
' Author : crystal (strive4peace)
' License : below code
' Code List: www.MsAccessGurus.com/code.htm https://www.msaccessgurus.com/VBA/Code/sql_LoopTables_TrimText.htm
​
​
Sub LoopTables_TrimText( _
Optional pBooChangeZLStoNull As Boolean = True _
)
' s4p 161005, 181207
On Error GoTo Proc_err
Dim db As DAO.Database _
, tdf As DAO.TableDef _
, oFld As DAO.Field
Dim sgTimer1 As Single _
, sgTimeElapse As Single
Dim sSQL As String _
, sTable As String _
, sField As String _
, sMsg As String _
, nCountTables As Long _
, nCountFields As Long _
, nCountTrim As Long _
, nCountNull As Long _
, nRecords As Long
sgTimer1 = Timer()
Set db = CurrentDb
nCountTables = 0
nCountFields = 0
nCountTrim = 0
nCountNull = 0
For Each tdf In db.TableDefs
With tdf
'skip system tables
If (.Attributes And dbSystemObject) = 0 Then
'set status bar with the table name
SysCmd acSysCmdSetStatus, .Name
sTable = "[" & .Name & "]"
nCountTables = nCountTables + 1
Debug.Print "*** " & nCountTables & ". " & sTable
For Each oFld In .Fields
If oFld.Type = 10 Then
sField = "[" & oFld.Name & "]"
nCountFields = nCountFields + 1
sSQL = "UPDATE " & sTable & " AS t " _
& " SET t." & sField & " = Trim(t." & sField & ")" _
& " WHERE Not IsNull(t." & sField & ")" _
& " AND t." & sField & " <> Trim(t." & sField & ")" _
& ";"
Debug.Print sSQL
db.Execute sSQL
nRecords = db.RecordsAffected
Debug.Print "----- " & Format(nRecords, "#,##0") & Space(9) & Now()
nCountTrim = nCountTrim + nRecords
'change ZLS to Null if desired
If pBooChangeZLStoNull Then
sSQL = "UPDATE " & sTable & " AS t " _
& " SET t." & sField & " = Null " _
& " WHERE t." & sField & " = """" " _
& ";"
Debug.Print sSQL
db.TableDefs.Refresh
DoEvents
db.Execute sSQL
nRecords = db.RecordsAffected
Debug.Print "----- " & Format(nRecords, "#,##0") & Space(9) & Now()
nCountNull = nCountNull + nRecords
End If
End If 'data type is text
Next oFld
End If 'test for system table
End With 'tdf
Next tdf
sgTimeElapse = (Timer() - sgTimer1)
sMsg = nCountFields & " fields in " & nCountTables & " tables checked " _
& vbCrLf & Space(3) & Format(nCountTrim, "#,##0") & " values trimmed" _
& vbCrLf & Space(3) & Format(nCountNull, "#,##0") & " ZLS set to Null" _
& vbCrLf & vbCrLf & " Elapsed Time: " & Format(sgTimeElapse, "#,##0.##") & " seconds"
Debug.Print " " & sMsg
MsgBox sMsg, , "Done"
Proc_exit:
On Error Resume Next
Set oFld = Nothing
Set tdf = Nothing
Set db = Nothing
SysCmd acSysCmdClearStatus
Exit Sub
Proc_err:
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " LoopTables_TrimText"
Resume Proc_exit
Resume
End Sub
'
' LICENSE
' You may freely use and share this code
' provided this license notice and comment lines are not changed;
' code may be modified provided you clearly note your changes.
' You may not sell this code alone, or as part of a collection,
' without my handwritten permission.
' All ownership rights reserved. Use at your own risk.
' ~ crystal (strive4peace) www.MsAccessGurus.com
'*************** Code End *******************************************************
Delete an Access Table
​​Public Sub DeleteTable(strTableName As String)
'Enable in line error handling
On Error Resume Next
'Try to delete table
DoCmd.DeleteObject acTable, strTableName
'Check if errors occured
If Err.Number = 0 Then
'No errors
Else
If Err.Number = 7874 Then
'Table not found, not a problem,it was probably deleted at some other point
ElseIf Err.Number = 2008 Then
MsgBox "Table " & strTableName & " is open, cannot be deleted"
Else
MsgBox Err.Number & " - " & Err.Description
End If
End If
'Resume normal error handling
On Error GoTo 0
End Sub
‘VBA Code to close all forms upon exiting (https://www.microsoftaccessexpert.com/Microsoft-Access-Code.aspx)
​
Public Function CloseAllForms()
Dim lngLoop As Long
For lngLoop = (Forms.Count - 1) To 1 Step -1
DoCmd.Close acForm, Forms(lngLoop).Name
Next lngLoop
End Function
‘VBA Code to convert the name of a month to a number (https://www.microsoftaccessexpert.com/Microsoft-Access-Code.aspx)
​
Public Function ChangeToMonth(sMonth As String) As Integer
Select Case sMonth
Case "Jan"
ChangeToMonth = 1
Case "Feb"
ChangeToMonth = 2
Case "Mar"
ChangeToMonth = 3
Case "Apr"
ChangeToMonth = 4
Case "May"
ChangeToMonth = 5
Case "Jun"
ChangeToMonth = 6
Case "Jul"
ChangeToMonth = 7
Case "Aug"
ChangeToMonth = 8
Case "Sep"
ChangeToMonth = 9
Case "Oct"
ChangeToMonth = 10
Case "Nov"
ChangeToMonth = 11
Case "Dec"
ChangeToMonth = 12
Case Else
ChangeToMonth = 0
End Select
End Function
AI generated: Prompt: "using VBA Code, show me how to export an Access table to an Excel file with a date extensionf"
Sub ExportTableToExcel()
Dim db As DAO.Database
Dim tableName As String
Dim exportPath As String
Dim dateSuffix As String
Dim fileName As String
' Set the name of the table you want to export
tableName = "YourTableName" ' Replace with your table name
' Get the current date and format it
dateSuffix = Format(Date, "yyyy-mm-dd")
' Set the export path and filename
exportPath = "C:\Path\To\Your\Folder\" ' Replace with your desired path
fileName = exportPath & tableName & "_" & dateSuffix & ".xlsx"
' Export the table to Excel
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, tableName, fileName, True
' Notify the user
MsgBox "Table exported successfully to: " & fileName
End Sub