VBAstarter
New member
- Local time
- Today, 03:15
- Joined
- Mar 19, 2014
- Messages
- 7
Hey all.
This is my first VBA application and I was assigned this task at work. I am learning as I go
Purpose of application
The user will select two dates. Start and End date. The user will hit the run button and the application will read an excel file with employee data and only display/output the records within that date range selected (employment date).
My code:
The problem
I am not getting the query displayed on the datasheet after it is done executing. It's just a blank sheet. Also the output file is just this:
I did a quick query test using SQL in Access and it worked fine there. I am guessing my error is somwhere in this section:
thanks!!
This is my first VBA application and I was assigned this task at work. I am learning as I go
Purpose of application
The user will select two dates. Start and End date. The user will hit the run button and the application will read an excel file with employee data and only display/output the records within that date range selected (employment date).
My code:
Code:
Option Compare Database
Function DeleteTable()
'Delete old records from AllEmployeesData table
On Error GoTo DeleteTable_Err
DoCmd.DeleteObject acTable = acDefault, "AllEmployeesData"
Exit Function
DeleteTable_Err:
If Err = 7874 Then
Resume Next
Else
MsgBox Error, Err
End If
End Function
Sub ReadfromExcelFile()
'Import new records into AllEmployeesData table
DoCmd.TransferSpreadsheet acImport, , "AllEmployeesData",
"C:\users\chrmjfa\desktop\AllEmps_030314.xlsx", True
End Sub
Code:
Option Compare Database
Private Sub Run_Click()
'**Delete old table and call new excel file**'
DeleteTable
ReadfromExcelFile
'--Declare my variables
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim tdf As TableDef, fld As DAO.field
Dim strSQL As String
Dim f As field
Dim start_date As Date
Dim end_date As Date
start_date = Trim(Me.txtStartDate)
end_date = Trim(Me.txtEndDate)
Set db = CurrentDb
'**Change [employ] data type to Date Field Type**'
'--Create New Field
db.TableDefs.Refresh
Set tdf = db.TableDefs("AllEmployeesData")
Set fld = tdf.CreateField("MyFieldNew", dbDate)
'Optional: set default value
fld.DefaultValue = "0"
'We set ordinal position, just after old field
fld.OrdinalPosition = 9
'And append
tdf.Fields.Append fld
'Copy values from old field to a new one
db.Execute _
"Update AllEmployeesData Set MyFieldNew=employ", dbFailOnError
'Delete old field
tdf.Fields.Delete "employ"
tdf.Fields.Refresh
'Rename new field to old
tdf.Fields("MyFieldNew").Name = "employ"
tdf.Fields.Refresh
'Done!
Set tdf = Nothing
'--End Change [employ] data type to Date Field Type**'
'--Select required fields
strSQL = "SELECT [AllEmployeesData].ssn, [AllEmployeesData].last, [AllEmployeesData].mi, [AllEmployeesData].first, [AllEmployeesData].employ FROM [AllEmployeesData] WHERE [AllEmployeesData].employ BETWEEN " & start_date & " and " & end_date & ""
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
'--Display query result on Datasheet and Output query to text file
With db
Set qdf = .CreateQueryDef("NewHireQuery", strSQL)
DoCmd.OpenQuery "NewHireQuery"
.QueryDefs.Delete "NewHireQuery"
End With
db.Close
qdf.Close
Set qdf = Nothing
Open "C:\users\chrmjfa\desktop\names.txt" For Output As #1
For Each f In rs.Fields
Print #1, f.Name
Next
Do While Not rs.EOF
Print #1, rs![ssn], rs![last], rs![mi], rs![first], rs![employ]
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
Close #1
Debug.Print "queryname = '" & strSQL & "'"
End Sub
Private Sub CmdClose_Click()
On Error GoTo Err_CmdClose_Click
DoCmd.Close
Exit_CmdClose_Click:
Exit Sub
Err_CmdClose_Click:
MsgBox Err.Description
Resume Exit_CmdClose_Click
End Sub
The problem
I am not getting the query displayed on the datasheet after it is done executing. It's just a blank sheet. Also the output file is just this:
Code:
ssn
last
mi
first
employ
I did a quick query test using SQL in Access and it worked fine there. I am guessing my error is somwhere in this section:
Code:
'--Display query result on Datasheet and Output query to text file
With db
Set qdf = .CreateQueryDef("NewHireQuery", strSQL)
DoCmd.OpenQuery "NewHireQuery"
.QueryDefs.Delete "NewHireQuery"
End With
db.Close
qdf.Close
Set qdf = Nothing
Open "C:\users\chrmjfa\desktop\names.txt" For Output As #1
For Each f In rs.Fields
Print #1, f.Name
Next
Do While Not rs.EOF
Print #1, rs![ssn], rs![last], rs![mi], rs![first], rs![employ]
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
Close #1
thanks!!