‘VBA Code to import all excel files from a certain directory and certain range to an Access table.
‘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.
Public Sub Import()
Dim strFile As String
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
'*********************************************
Msg = ""
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
DoCmd.SetWarnings False
strPath = "J:\your directory\"
' Tell it to import all Excel files from the file directory
strFile = Dir(strPath & "*.xlsx*")
' Start loop
'*********************************************
Do While strFile <> ""
' Import file
DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:="YourAccessTableName", FileName:=strPath & strFile, HasFieldNames:=False, Range:="A2:AN800"
' Loop to next file in directory
strFile = Dir
Loop
'*********************************************
DoCmd.SetWarnings True
MsgBox "The file(s) have been imported."
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.
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 run a macro.
‘This is my example.
‘Just put the code behind a command button on a form and change the command button name.
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
Highlight Blank Cells
(Put this code in a macro then highlight the range of the data. Then run the macro)
Sub Highlight_Blank_Cells()
Dim DataSet As Range
Set DataSet = Selection
DataSet.Cells.SpecialCells(xlCellTypeBlanks).Interior.Color = vbBlue
End Sub
Highlight Spelling Areas
(Select the range first)
Sub Chech_Spelling_Mistake()
Dim MySelection As Range
For Each MySelection In ActiveSheet.UsedRange
If Not Application.CheckSpelling(Word:=MySelection.Text) Then
MySelection.Interior.Color = vbRed
End If
Next MySelection
End Sub
Insert a blank row after every other row
(Put this code in a macro then select the range)
Sub Insert_Row_After_Every_Other_Row()
Dim rng As Range
Dim CountRow As Integer
Dim i As Integer
Set rng = Selection
CountRow = rng.EntireRow.Count
For i = 1 To CountRow
ActiveCell.EntireRow.Insert
ActiveCell.Offset(2, 0).Select
Next i
End Sub