Hi I have been trying this for hours and it doesn't matter how much I search to try different options I cannot get the lookup for give a result that I am looking for. I am testing it using a date and work code that I know is in the table that I am referring to.
I am using the input box to provide the date and fixing the work code as 13 (Dispatch). The lookup should be returning the date in the table as the date input is in the table. My code is:
Sub Append_Dispatch()
Dim dbs As Object
Dim qdf As querydef
Dim InputDateString As String
Dim InputDate As Date
Dim RtnDate As String
Dim chkDate As Date
Dim WC As Long
Set dbs = CurrentDb
Set qdf = dbs.querydefs("Dispatch Append to Production Data")
WC = 13
InputDateString = InputBox("Please enter start date to import", "Date")
InputDate = DateValue(InputDateString)
RtnDate = DLookup("[Date of Action]", "Production Data", "[Date of Action]= #" & InputDate & "# AND [Work Code] = " & WC & "")
chkDate = DateValue(RtnDate)
If InputDate = chkDate Then
IB = MsgBox("This dispatch date has already been entered:" & vbCrLf & "Please check and use a date after " & Dte, vbOKOnly, "Date Error")
Exit Sub
End If
'qdf.Parameters("Dispatch Date").Value = InputDate
'qdf.Execute
'qdf.Close
'Set qdf = Nothing
'Set dbs = Nothing
End Sub
Also I cannot get the code to work after the end if to input the parameter and run the append query. But that is another issue.
Any ideas please.....
Related
The code below generates PDF reports for supervisors who have employees expiring between StartDate and StopDate fields on a form. I am getting multiple reports for supervisors who do not have employees expiring in that range, blank reports essentially. The code also puts out the correct reports that have data.
How can I prevent OutputTo from saving the blank reports?
SQL for reference query (qry_Distinct_Supervisors):
PARAMETERS StartDate DateTime, StopDate DateTime;
SELECT DISTINCT qry_Base_For_All.Supervisor, qry_Base_For_All.LID, qry_Base_For_All._Status, qry_Base_For_All.LASTNAME, qry_Base_For_All.FIRSTNAME, qry_Base_For_All.[End Date]
FROM qry_Base_For_All
WHERE (((qry_Base_For_All.Supervisor) Is Not Null) AND ((qry_Base_For_All.LASTNAME) Is Not Null) AND ((qry_Base_For_All.[End Date]) Between [StartDate] And [StopDate]));
SQL for Report
SELECT DISTINCT qry_Base_For_All.L_ID, qry_Base_For_All.LASTNAME, qry_Base_For_All.FIRSTNAME, qry_Base_For_All.P_ID, qry_Base_For_All.Company, qry_Base_For_All.[End Date], qry_Base_For_All.Supervisor, qry_Base_For_All.Title
FROM qry_Base_For_All
WHERE (((qry_Base_For_All.[End Date]) Between [Forms]![frm_Bldg_Access]![StartDate] And [Forms]![frm_Bldg_Access]![StopDate]) AND ((qry_Base_For_All.Title) Like "*" & "outsource" & "*"));
VBA to save reports
Private Sub btn_Print_Report_Click()
'split report into PDFs named after supervisor and open a separate email with each report attached
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MyFileName As String
Dim mypath As String
Dim temp As String
Dim qry As QueryDef
Dim StartDate As DAO.Parameter
Dim StopDate As DAO.Parameter
Set db = CurrentDb()
Set qry = db.QueryDefs("qry_Distinct_Supervisors")
mypath = "C:\Users\cw52450\Desktop\Test Exports\"
qry.Parameters("StartDate").Value = Forms!frm_Bldg_Access!StartDate
qry.Parameters("StopDate").Value = Forms!frm_Bldg_Access!StopDate
Set rs = qry.OpenRecordset(dbOpenSnapshot)
'populate rs
If Not (rs.EOF And rs.BOF) Then
rs.MoveLast
rs.MoveFirst
'start report generation loop
'Currenlty outputting blank reports as well as needed ones
Do While Not rs.EOF
temp = rs("Supervisor")
MyFileName = rs("Supervisor") & Format(Date, ", mmm yyyy") & ".PDF"
DoCmd.OpenReport "rpt_Expiring_Access", acViewReport, , "[Supervisor]='" & temp & "'"
DoCmd.OutputTo acOutputReport, "", acFormatPDF, mypath & MyFileName
DoCmd.Close acReport, "rpt_Expiring_Access"
DoEvents
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Report generation complete."
Set rs = Nothing
Set db = Nothing
Set qry = Nothing
End Sub
Dim mydb As DAO.Database
Dim myrst As DAO.Recordset
Dim Date1, Date2 As Date
Dim mysql As String
Dim qdf As QueryDef
Dim EmployeeID As String
EmployeeID = DLookup("lngEmpID", "tblEmployees", "Forms!frmEmployeeOrderForm.cboEmployeeName.Value = EmployeeName")
Me.EmpID = EmployeeID
PickupTime = DLookup("Pickup", "tblEmployees", "Forms!frmEmployeeOrderForm.cboEmployeeName.Value = EmployeeName")
Me.PickupDay = PickupTime
Set mydb = CurrentDb
Date1 = Me.dtmGiveAwayDate1
Date2 = Me.dtmGiveAwayDate2
mysql = ("Select tblOrders.lngEmpID, tblOrders.dtmGiveAwayDate1, tblOrders.dtmGiveAwayDate2 FROM tblOrders WHERE tblOrders.lngEmpID =" & EmployeeID & " AND tblOrders.dtmGiveAwayDate1 =" & Date1 & " AND tblOrders.dtmGiveAwayDate2 =" & Date2)
MsgBox mysql
Set myrst = mydb.OpenRecordset(mysql)
If myrst.EOF = False Then
MsgBox "You have already ordered for this PFG." & vbCrLf & "Please see Jody for help."
cmdCancel_Click
Exit Sub
End If
When I run the program I am trying to prevent employees from entering their name twice for the same dates. To test I tried to duplicate a record for the same employee and it will not trigger the myrst.eof = false and display the message box that says "You have already ordered for this PFG". Any help is much appreciated.
Thank you in advance.
Use the FindFirst method :
myrst.FindFirst "field = " & value
If myrst.NoMatch Then
//code when record doesn't exist
End If
Checking for equality with dates can be tricky. Since VBA dates can include time to the nanosecond, could it be that one side (SQL/code) has a real time, while the other has the default midnight value?
Set mydb = CurrentDb
Date1 = Format(Me.dtmGiveAwayDate1, "Short Date")
Date2 = Format(Me.dtmGiveAwayDate2, "Short Date")
mysql = ("Select tblOrders.lngEmpID, tblOrders.dtmGiveAwayDate1, tblOrders.dtmGiveAwayDate2 FROM tblOrders WHERE tblOrders.lngEmpID =" & EmployeeID & " AND tblOrders.dtmGiveAwayDate1 =" & "#" & Date1 & "#" & " AND tblOrders.dtmGiveAwayDate2 =" & "#" & Date2 & "#")
MsgBox mysql
Set myrst = mydb.OpenRecordset(mysql)
This was the code I used and it works now. Thank you.
I am trying to run a query from the Access Query designer that is working fine in Access but when I try to bring the statement across to VBA it is giving me this error message:
Run time error too few parameters. Expected 2.
I have printed the statement in the immediate window and run it in Access and it is running without asking for parameters. I have done a number of web searches the general consensus seems to be to declare it all in VBA, including the parameters -
Private Sub CmdAppend_Click()
Dim db1 As Database
Dim mystr As Recordset2
Dim UserName As String
Dim UpdateSQL As String
Dim SelectIDSQL As String
Dim checkstr As String
If Validate_Data = True Then
UserName = Environ$("Username")
SelectIDSQL = "Select Distinct ChecklistResults.[StaffID]" _
& " From ChecklistResults" _
& " Where (((ChecklistResults.[ClientID])=[Forms]![TeamLeader]![ComClientNotFin])" _
& " And ((ChecklistResults.[DateofChecklist])=[Forms]![TeamLeader]![ComDateSelect])" _
& " AND ((ChecklistResults.[ManagerID]) Is Null));"
Debug.Print SelectIDSQL
Set db1 = CurrentDb
Set mystr = db1.OpenRecordset(SelectIDSQL)
checkstr = mystr!StaffID
If checkstr <> UserName Then
I receive the above error message when I try to set mystr to the recordset. I think I can get the recordset by following the format below but is there a way of getting the above SQL statement/assignment to work?
Dim qdf1 As DAO.QueryDef
Set qdf1 = db1.QueryDefs("Get_StaffID")
qdf1.Parameters(0) = [Forms]![TeamLeader]![ComClientNotFin]
qdf1.Parameters(1) = [Forms]![TeamLeader]![ComDateSelect]
Set rst1 = qdf1.OpenRecordset(dbOpenDynaset)
As I look at this page, I see examples where the OpenRecordSet method takes two arguments. You have an error message that says something was expecting 2 parameters. Try changing this:
Set mystr = db1.OpenRecordset(SelectIDSQL)
to this:
Set mystr = db1.OpenRecordset(SelectIDSQL, dbOpenDynaset)
Thanks for the input, I used the following code to get the result I was looking for. It uses the query SelectClientID to return the ID of the person who completed the first stage of a checklist. it then checks the person who has done the second check and if they match it returns an error message. If two different people have completed it, it uses the SQL statement to update the previous record with the second checker's ID -
Private Sub CmdAppend_Click()
Dim rst1 As Recordset2
Dim db1 As Database
Dim mystr As Recordset2
Dim UserName As String
Dim UpdateSQL As String
Dim SelectIDSQL As String
Dim checkstr As String
Dim qdf1 As DAO.QueryDef
Set db1 = CurrentDb
Set qdf1 = db1.QueryDefs("SelectClientID")
qdf1.Parameters(0) = [Forms]![TeamLeader]![ComClientNotFin]
qdf1.Parameters(1) = [Forms]![TeamLeader]![ComDateSelect]
Set rst1 = qdf1.OpenRecordset(dbOpenDynaset)
If Validate_Data = True Then
UserName = Environ$("Username")
UpdateSQL = "UPDATE ChecklistResults" _
& " SET ChecklistResults.[ManagerID] = '" & UserName & "'" _
& " WHERE (((ChecklistResults.[ClientID])=[Forms]![TeamLeader]![ComClientNotFin])" _
& " AND ((ChecklistResults.[DateofChecklist])=[Forms]![TeamLeader]![ComDateSelect])" _
& " AND ((ChecklistResults.[ManagerID]) Is Null));"
checkstr = rst1!StaffID
If checkstr <> UserName Then
DoCmd.SetWarnings False
DoCmd.RunSQL UpdateSQL
DoCmd.SetWarnings True
DoCmd.Close
Else
MsgBox ("This Checklist was created by you and cannot therefore Checked by you")
End If
Else
Exit Sub
End If
End Sub
I am currently have an USER INTERFACE (a Form) in Access which has two combo boxes referring to a specific date of a quarter. The form values are queried in from a pass through query from SQL SERVER 2008.
Is there any way in which I can write a pass through query which will use the form values in where condition.
For eg :
INSERT INTO TBL.ABC
SELECT * FROM TBL.DEF where [Date]=Formvalue
After all of the research and I even have gone through couple of questions posted in Stackoverflow, but couldnt find the answer. Is this even possible ??
The main motive behind doing this is to segregate the data into two different tables based on the input as a form of "FormValue" and then perform different operations based on the dates.
Please do let me kno if you need further information. Any help is much appreciated!!
Private Sub Command13_Click()
Dim St001, St002 As String
Dim conn As ADODB.Connection
Dim strPath As String
Dim strDate As String
Set conn = CurrentProject.Connection
strPath = "ServerName"
'conn.Open = "ODBC;DRIVER=SQL Server;SERVER=" & strpath & ";
' DATABASE=DB;UID=ABC;PWD=DEF;Trusted_Connection=No;"
'DoCmd.OpenQuery "003a Drop Curr_Qtr"
strDate = curQtr & ""
StrDate2 = prevQtr & ""
' If combo box is empty?
If strDate = "" Then
MsgBox "The Curr Qtr Date value is Empty, Please select the date"
ElseIf StrDate2 = "" Then
MsgBox "The Date Prev Qtr Date value is Empty, Please select the date"
Else
' Append values
DoCmd.OpenQuery "003a Drop Curr_Qtr"
'On Error Resume Next
St002 = "SELECT COLUMNS into TblB from TblA where ColA='" & strDate & "'
DoCmd.RunSQL St002
As scuh, all the tables that I am reffering to in the code are linked tables. I tried using the below format of the code as suggested in one of the form, but it is the same error that pops up all the time :
Dim St001, St002 As String
Dim conn As ADODB.Connection
Dim strPath As String
Dim strDate As String
Set conn = CurrentProject.Connection
strPath = "ServerName"
'conn.Open = "ODBC;DRIVER=SQL Server;SERVER=" & strpath & ";DATABASE=DBName;
' UID=Username;PWD=password;Trusted_Connection=No;"
'DoCmd.OpenQuery "003a Drop table"
strDate = curQtr & ""
StrDate2 = prevQtr & ""
' If combo box is empty?
If strDate = "" Then
MsgBox "The Curr Date value is Empty, Please select the date"
ElseIf StrDate2 = "" Then
MsgBox "The Prev Date value is Empty, Please select the date"
Else
' Append values
DoCmd.OpenQuery "003a truncate table"
'conn.Open = "ODBC;DRIVER=SQL Server;SERVER=" & strPath & ";DATABASE=009;
' UID=GM_SA;PWD=gmsa;Trusted_Connection=No;"
'On Error Resume Next
St002 = "Insert Into [Tabl B] ([Tabl B].[ColA]" & _
"Select [Tabl A].[Col A] from [tabl A].[Col A] where [Tabl A].[Col z]='" & strDate & "'"
strCon = "ODBC;DRIVER=SQL Server;SERVER=" & strPath & ";DATABASE=DBName;UID=UserName;" _
& "PWD=Password;Trusted_Connection=No"
Set wksp = DBEngine(0)
Set dabs = wksp.opendatabase("", False, False, strCon)
dabs.Execute St002, dbSQLpassThrough
End If
End Sub
Try the following, after making sure you have a reference to Microsoft ActiveX Data Objects 2.8 Library
Dim adoConn As ADODB.Connection
...
St002 = "Insert Into [Tabl B] ([ColA]) Select [Tabl A].[Col A] from [tabl A].[Col A] where [Tabl A].[Col z]='" & FORMAT(strDate,"yyyy-mm-dd") & "'"
strCon = "ODBC;DRIVER=SQL Server;SERVER=" & strPath & ";DATABASE=DBName;UID=UserName;PWD=Password;Trusted_Connection=No"
adoConn.Open(strCon)
adoConn.Execute St002
Using ADO instead of DAO is often a better option when passing queries directly to servers, it should completely bypass any possibility of errors similar to "RUNTIME ERROR 3024 - Could not find file 'H:\TableName.Mdb"
Also, if you need a value from a combo column other than the bound column, use Me.DateCombo.Column(1) or similar. Access uses 0-based indexes, so Me.DateCombo.Column(1) refers to the second column.
Our requirement -
We have few suppliers and we want to generate a monthly report of purchases from each supplier during the month and export to excel. I think the solution is to create a parameter query where I can pass the value of the supplier ID, Month and Year. The list of supplier keeps changing and is stored in a separate table.
So, basically, I should be able to sequentially read the supplier ID from that table and pass as a parameter to my query to generate the report for that supplier.
The closest solutions that I found for my requirement was on (which are similar in nature) -
Exporting Recordset to Spreadsheet
http://answers.microsoft.com/en-us/office/forum/office_2010-customize/filtering-a-query-used-by-docmdtransferspreadsheet/06d8a16c-cece-4f03-89dc-89d240436693
Why I think there could be a better solution -
In the suggested solution, we are creating multiple queries and deleting these. Conceptually, I feel there should be a way to create a parameter query and use the do while loop to sequentially pass the value of the parameter (DeptName in above example) to the query and export the results to excel.
I should be able to achieve this if I can use vba to pass value to a parameter query. And that is what I have not yet been able to figure out.
Update on 24-Feb -
Following is the code that I have written -
Private Sub Monthly_Supplier_Sales_Report_Click()
Dim strDirectoryPath As String
Dim DateFolderName As String
DateFolderName = Format$((DateSerial(year(Date), month(Date), 1) - 1), "YYYY MM")
strDirectoryPath = "C:\dropbox\Accounting\Sales Reports\" & DateFolderName
If Dir(strDirectoryPath, vbDirectory) = "" Then MkDir strDirectoryPath
Dim Filename As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim DesignerCode As String
Dim month1 As String
Dim year1 As Integer
Dim Query1 As DAO.QueryDef
Dim query2 As DAO.QueryDef
Dim rsDesigner As DAO.Recordset
Set rsDesigner = CurrentDb.OpenRecordset("Designer Details Master")
Do While Not rsDesigner.EOF
DesignerCode = rsDesigner![Designer Code]
month1 = "Jan" 'right now hardcoded, will call this programatically
year1 = 2014 'right now hardcoded, will call this programatically
strSQL1 = "SELECT * FROM [Sales Report Generation Data] WHERE [designer code] = '" & DesignerCode & "' AND [Shipping Month]= '" & month1 & "' AND [Shipping Year]=" & year1
strSQL2 = "SELECT * FROM [Sales Report Generation - Monthwise Inventory Snapshot] WHERE [designer code] = '" & DesignerCode & "' AND [Snapshot Month]= '" & month1 & "' AND [Snapshot Year]= " & year1
Set Query1 = CurrentDb.CreateQueryDef(Name:="TempSalesQuery", SQLText:=strSQL1)
Set query2 = CurrentDb.CreateQueryDef(Name:="TempInventoryQuery", SQLText:=strSQL2)
Filename = strDirectoryPath & "\" & DesignerCode & Format$(Now(), " yyyy mm") & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "TempSalesQuery", Filename, False, "Sales Report"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "TempInventoryQuery", Filename, False, "Inventory"
CurrentDb.QueryDefs.Delete "TempSalesQuery"
CurrentDb.QueryDefs.Delete "TempInventoryQuery"
rsDesigner.MoveNext
Loop
End Sub
Instead, The logic I want to apply is -
Do While Not
assign Value to Parameter 1 = rsDesigner![Designer Code]
assign Value to Parameter 2 = Month1
assign Value to Parameter 3 = Year1
Run the two Parameter queries, for which about three parameters are the input value and export to excel in respective sheets.
Loop
Just that I have not yet been able to figure out - how to achieve this.
Here is one solution. Note that I created Functions that the two queries will use.
Just create your two queries and save them (see sample SQL below), add your code to pick dates and everything should be fine.
Option Compare Database
Option Explicit
Dim fvShipMonth As String
Dim fvShipYear As Integer
Dim fvDesignerCode As String
Public Function fShipMonth() As String
fShipMonth = fvShipMonth
End Function
Public Function fShipYear() As Integer
fShipYear = fvShipYear
End Function
Public Function fDesignerCode() As String
fDesignerCode = fvDesignerCode
End Function
Private Sub Monthly_Supplier_Sales_Report_Click()
Dim Filename As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim DesignerCode As String
Dim month1 As String
Dim year1 As Integer
Dim rsDesigner As DAO.Recordset
'SAMPLE SQL
'SELECT * FROM [Sales Report Generation Data] " & _
'WHERE [designer code] = '" & fDesignerCode() & "' AND [Shipping Month]= '" & fShipMonth() & "' AND [Shipping Year]=" & fShipYear()
fvShipMonth = "Jan"
fvShipYear = 2014
Set rsDesigner = CurrentDb.OpenRecordset("Designer Details Master")
Do While Not rsDesigner.EOF
fvDesignerCode = rsDesigner![Designer Code]
Filename = strDirectoryPath & "\" & DesignerCode & Format$(Now(), " yyyy mm") & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "<your Query 1>", Filename, False, "Sales Report"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "<your Query 2>", Filename, False, "Inventory"
rsDesigner.MoveNext
Loop
rsDesigner.Close
Set rsDesigner = Nothing
End Sub
Open your database
Create a NEW module
Paste the following code
Place your cursor inside Function TEST_MY_CODE()
Press F5
Paste the results from the immediate window in your response.
Option Compare Database
Option Explicit
Dim fvShipMonth As String
Dim fvShipYear As Integer
Dim fvDesignerCode As String
Public Function fShipMonth() As String
fShipMonth = fvShipMonth
End Function
Public Function fShipYear() As Integer
fShipYear = fvShipYear
End Function
Public Function fDesignerCode() As String
fDesignerCode = fvDesignerCode
End Function
Function TEST_MY_CODE()
My_Click_EVENT ' Test the code I provided
End Function
Private Sub My_Click_EVENT()
Dim month1 As String
Dim year1 As Integer
fvShipMonth = "Jan"
fvShipYear = 2014
Debug.Print "**** START TEST ****"
Debug.Print "fvShipMonth = " & fvShipMonth
Debug.Print "fvShipYear = " & fvShipYear
Debug.Print "fShipMonth() = " & fShipMonth()
Debug.Print "fShipYear() = " & fShipYear()
Debug.Print "**** END TEST ****"
End Sub