Monthly I have to import data from an Excel sheet. It takes a while to import so I would like to have a progress bar. There is a small progress bar native to Access at the bottom of the screen, but I would like one in the middle of the screen. Here is my current code to import the table. The DOB field in the excel sheet is backwards so the extra code is to flip the date data around.
Private Sub Update_Click()
On Error GoTo Err_Update_Click
CurrentDb.Execute "ALTER TABLE [Updated Table] DROP COLUMN DOB;"
CurrentDb.TableDefs("Updated Table").Fields("DOBString").Name = "DOB"
With DoCmd
.SetWarnings False
.OpenQuery "updated table delete query"
.SetWarnings True
.TransferSpreadsheet transfertype:=acImport, tablename:="Updated Table", FileName:=Me.BrowseTextBox, HasFieldNames:=True
End With
CurrentDb.Execute "ALTER TABLE [Updated Table] ADD COLUMN DOBTemp Date;"
CurrentDb.Execute "UPDATE [Updated Table] SET [Updated Table].DOBTemp = CDate(Mid(CStr([DOB]),5,2) & '/' & Right(CStr([DOB]),2) & '/' & Left(CStr([DOB]),4));"
CurrentDb.TableDefs("Updated Table").Fields("DOB").Name = "DOBString"
CurrentDb.TableDefs("Updated Table").Fields("DOBTemp").Name = "DOB"
Exit_CmdImportExcel_Click:
Exit Sub
Err_Update_Click:
MsgBox Err.Description
Resume Exit_Update_Click
Exit_Update_Click:
End Sub
Private Sub Update_Click()
On Error GoTo Err_Update_Click
CurrentDb.Execute "ALTER TABLE [Updated Table] DROP COLUMN DOB;"
CurrentDb.TableDefs("Updated Table").Fields("DOBString").Name = "DOB"
With DoCmd
.SetWarnings False
.OpenQuery "updated table delete query"
.SetWarnings True
.TransferSpreadsheet transfertype:=acImport, tablename:="Updated Table", FileName:=Me.BrowseTextBox, HasFieldNames:=True
End With
CurrentDb.Execute "ALTER TABLE [Updated Table] ADD COLUMN DOBTemp Date;"
CurrentDb.Execute "UPDATE [Updated Table] SET [Updated Table].DOBTemp = CDate(Mid(CStr([DOB]),5,2) & '/' & Right(CStr([DOB]),2) & '/' & Left(CStr([DOB]),4));"
CurrentDb.TableDefs("Updated Table").Fields("DOB").Name = "DOBString"
CurrentDb.TableDefs("Updated Table").Fields("DOBTemp").Name = "DOB"
Exit_CmdImportExcel_Click:
Exit Sub
Err_Update_Click:
MsgBox Err.Description
Resume Exit_Update_Click
Exit_Update_Click:
End Sub