MisterTootor M.S., B.S., A.S., A.S.B
I'm a paragraph. Click here to add your own text and edit me. It's easy.
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