ms access form criteria help error - string

I am trying to open a form with criteria.
My criteria where I am getting the error.
strCriteria = "WorkID = 3 And
OptOut= -1 And
AppointmentDate = (Last(AppointmentDate))>DateSerial(Year(Date()),Month(Date())-3,1) And
(Last(AppointmentDate))<DateSerial(Year(Date()),Month(Date())-2,0)"
I placed it like this in order to read it easier.
My error number is 3096.
Thank you.
==== Update I give up =======
My code so far.
strSQL = "SELECT tblAppointment.WorkID," & _
"tblCustomer.OptOut," & _
"Last(tblAppointment.AppointmentDate) AS LastAppointmentDate," & _
"tblAppointment.CustomerID," & _
"tblCustomer.Surname," & _
"tblCustomer.Name," & _
"tblCustomer.FatherName," & _
"Last(tblAppointment.AppointmentMemo) AS LastAppointmentMemo" & _
"FROM tblCustomer INNER JOIN tblAppointment ON tblCustomer.CustomerID = tblAppointment.CustomerID " & _
"GROUP BY tblAppointment.WorkID," & _
"tblCustomer.OptOut," & _
"tblAppointment.CustomerID," & _
"tblCustomer.Surname," & _
"tblCustomer.Name," & _
"tblCustomer.FatherName " & _
"HAVING (((tblAppointment.WorkID) = 3) And ((tblCustomer.OptOut) = -1) And " & _
"(LastAppointmentDate > DateSerial(Year(Date()), Month(Date()) - 3, 1) And " & _
"LastAppointmentDate < DateSerial(Year(Date()), Month(Date()) - 2, 0)))" & _
"ORDER BY LastAppointmentDate, " & _
"tblCustomer.Surname," & _
"tblCustomer.Name," & _
"tblCustomer.FatherName;"

I see you are still having trouble. Let's look at the code you have given us.
Your having statement is looking for a field that does not exist on the table. You currently have:
Having (((tblAppointment.WorkID) = 3) And ((tblCustomer.OptOut) = -1) And " & _
"(LastAppointmentDate > DateSerial(Year(Date()), Month(Date()) - 3, 1) And " & _
"LastAppointmentDate < DateSerial(Year(Date()), Month(Date()) - 2, 0)))" & _
Your having clause is looking for LastAppointmentDate on your table. This field does not exist since the field name is AppointmentDate. Change your field name in your having statement to match the field name and it should work. You also have missing parenthesis.
Having (((tblAppointment.WorkID) = 3) AND ((tblCustomer.optout) = -1) AND " & _
"((tblAppointment.AppointmentDate) > DateSerial(Year(Date()), Month(Date()),-3,1)) AND " & _
"((tblAppointment.AppointmentDate) < DateSerial(Year(Date()), Month(Date()),-2,0))) " & _
Try this solution to your having statement. If it does not work, let me know and I'll do more digging.

There isn't much information to go off of with your question, but I'm going to take a stab at it.
I'm assuming you are trying to open a form with the following code:
docmd.openform "FormName",acnormal,,strcriteria
If this is the case, you variable is looking for a last appointment date that hasn't been established or discovered yet. basically, you set a criteria to a field on a form that isn't loaded yet, thus, no information can be used.
You can try a different approach that has done justice for me multiple times and I continue to use this method today.
private sub Eventtrigger()
dim frm as form
dim strSQL as string
strsql = "SELECT * " & _
"FROM TableName " & _
"WHERE (((TableName.workID) = 3 AND (TableName.OptOut) = -1 AND (TableName.AppointmentDate) > DateSerial(year(date()),Month(Date())-3,1) AND (TableName.AppointmentDate) < DateSerial(year(date()),Month(date())-2,0)));"
'Edited since I missed 2 closing parenthesis
Docmd.openform "FormName",acnormal
set frm = [forms]![FormName] 'New form opened
frm.recordsource = strsql
EndCode:
if not frm is nothing then
set frm = nothing
end if
end sub
The above code will allow you to set the recordsource of the form to the newly created query. which the query will filter the results for you.
Or, to fix you variable, Just set your variable as follows:
strcriteria = "WorkID = 3 AND OptOut = -1 AND " & _
"AppointmentDate > DateSerial(Year(date()),Month(date())-3,1) AND " & _
"AppointmentDate < DateSerial(Year(date()),Month(date())-2,0)"
If you need last, use last on AppointmentDate:
Last(AppointmentDate) > DateSerial(Year(date()),Month(Date())-3,1) AND " & _
Last(AppointmentDate) < DateSerial(Year(date()),Month(Date())-2,0)
Let me know if either of these methods/repairs didn't work and I will do more digging.

Related

Unable to Import CSV to Access

I am working on project where i have to make a report but due to heavy nature to raw dumps i am using access i can use access decently but i want to automate my manual task like import multiple files into table. for your refence i am not that great in VBA but i can do rnd and all stuff to get result or else last hope Stack overflow so below is my code everything is working fine but data is not imported in table but i can see row counts are proper so where is data is do not know please help and if possible can you guide me to short the coding as i am taking long road to code and as for error i am attaching pic of it how it looks.
thank you in advance !!!
My Code:-
Private Sub Command0_Click()
Dim Path As String
Dim SFC1, SFC2, SFQ3, SFQ4, SFQ5, SFQ6, SFC7, SFC8, SFC9, SFC10, SFC11, SFC12 As Variant
Dim SFG1, SFG2, SFG3, SFG4, SFG5, SFG6, SFG7, SFG8, SFG9 As Variant
Path = "C:\Users\Kunal.Khaire\Desktop\POD KPI Access\Raw\"
SFC1 = "13_Nulceus.csv"
SFC2 = "1_Mastersheet_Cisco.csv"
SFQ3 = "5_Overall_Performance_(2).csv"
SFQ4 = "6_Overall_Performance_(3).csv"
SFQ5 = "7_Overall_Performance_(4).csv"
SFQ6 = "8_Overall_Performance_(5).csv"
SFC7 = "9_OB_Calls_not_Tagged.csv"
SFC8 = "4_Quiz_Level.csv"
SFC9 = "2_Toggle_Count.csv"
SFC10 = "3_Agent_Disconnection.csv"
SFC11 = "11_Call_Not_Answered.csv"
SFC12 = "10_LB_Tagged_Dump.csv"
SFG1 = "APR Raw - Genesys.csv"
SFG2 = "Day-Wise Agent Level.csv"
SFG3 = "Overall Tagging Summary Data.csv"
SFG4 = "Genesys - CSAT by Date.csv"
SFG5 = "9_OB_Calls_not_Tagged (1).csv"
SFG6 = "2_Toggle_Count (1).csv"
SFG7 = "3_Agent_Disconnection (1).csv"
SFG8 = "11_Call_Not_Answered (1).csv"
SFG9 = "10_LB_Tagged_Dump (1).csv"
DoCmd.TransferText TransferType:=acImportDelim, _
TableName:="Nucleus", _
FileName:=(Path & SFC1), _
HasFieldNames:=True
DoCmd.TransferText TransferType:=acImportDelim, _
TableName:="Master_Cisco", _
FileName:=(Path & SFC2), _
HasFieldNames:=True
DoCmd.TransferText TransferType:=acImportDelim, _
TableName:="Quality_1", _
FileName:=(Path & SFQ3), _
HasFieldNames:=True
DoCmd.TransferText TransferType:=acImportDelim, _
TableName:="Quality_2", _
FileName:=(Path & SFQ4), _
HasFieldNames:=True
DoCmd.TransferText TransferType:=acImportDelim, _
TableName:="Quality_3", _
FileName:=(Path & SFQ5), _
HasFieldNames:=True
DoCmd.TransferText TransferType:=acImportDelim, _
TableName:="Quality_4", _
FileName:=(Path & SFQ6), _
HasFieldNames:=True
DoCmd.TransferText TransferType:=acImportDelim, _
TableName:="C_OBcallnottagged", _
FileName:=(Path & SFC7), _
HasFieldNames:=True
MsgBox "Importing of CSV are done !!!!"
End Sub

Convert excel print page to pdf and send to email on the print page

I'd like to make a VBA code in excel but I'm stuck. I want it to take my worksheet where I have several pages to print (50 pages in one worksheet).
On every print page there is a sum and if that sum is greater than 0 I want to convert that page to a pdf and send the print page to the email on the page (so it's different emails).
The sum is in F22 and email is in B8 on page 1.
The sum is in F72 and email is in B58 on page 2.
So the range changes by 50 rows every page.
The emails area is B2:F50 on first page and B52:F100 on second page, B102:F150 on the third.
I have tried but can only do it with 1 page and 1 email.
here is the code i have, work for 1 page
Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
Dim Charge As Integer
Charge = ThisWorkbook.Sheets("Crosscharge").Cells(23, 6).Value
If Charge > 0 Then
Dim FileName As String
If ActiveWindow.SelectedSheets.Count > 1 Then
MsgBox "There is more then one sheet selected," & vbNewLine & _
"ungroup the sheets and try the macro again"
Else
'Call the function with the correct arguments
'For a fixed range use this line
FileName = RDB_Create_PDF(Source:=Range("B2:F50"), _
FixedFilePathName:="", _
OverwriteIfFileExist:=True, _
OpenPDFAfterPublish:=False)
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
StrTo:="Email", _
StrCC:="", _
StrBCC:="", _
StrSubject:="Text", _
Signature:=True, _
Send:=False, _
StrBody:="<H3><B>Dear Customer</B></H3><br>" & _
"<body>See the attached PDF file with the." & _
"<br><br>" & "Kind regards</body>"
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If
End If
End Sub
Hope you can help
What you need to do is implement a loop. The fact that your cells are exactly 50 apart for each page makes this very easy for your code. Another note that I see if that you assign the value in cell F23 to an Integer at the very beginning. Unless you can guarantee that it will always be an integer (for example you're rounding) it might be better to define it as Double Also the Integer type can only hold numbers between ~ - 2 billion and 2 billion. If you might be dealing with numbers larger then that use Long.
I was unable to test this code in it's entirety because you call on some custom functions, but try this. If there are any issues let me know and I will update this code.
Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
Dim Charge As Long
Dim LastRow As Long
Dim FileName As String
Dim i As Long
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
If ActiveWindow.SelectedSheets.Count > 1 Then
MsgBox "There is more then one sheet selected," & vbNewLine & _
"ungroup the sheets and try the macro again"
End If
i = 23
Do While i <= LastRow
Charge = ThisWorkbook.Sheets("Crosscharge").Cells(i, 6).Value
If Charge > 0 Then
'Call the function with the correct arguments
'For a fixed range use this line
FileName = RDB_Create_PDF(Source:=Range("B2:F" & i + 27), _
FixedFilePathName:="", _
OverwriteIfFileExist:=True, _
OpenPDFAfterPublish:=False)
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
StrTo:="Email", _
StrCC:="", _
StrBCC:="", _
StrSubject:="Text", _
Signature:=True, _
Send:=False, _
StrBody:="<H3><B>Dear Customer</B></H3><br>" & _
"<body>See the attached PDF file with the." & _
"<br><br>" & "Kind regards</body>"
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If
End If
i = i + 50
Loop
End Sub

Retrieve the latest status of a value by date and time

In my excel sheet "Progress Status" I have 2 columns, the first one contain the list of all the test cases that are including during my cycle and in the second column I want to get the latest status of the test case from an other sheet named "All run TestCases".
I tried using some excel function to get the latest date and time so that I can get the latest status of a test case but I didn't succeed because I don't have a deep knowledge of them, Can someone please help me with this.The picture shows how my two sheet look like.
Okay here is the answer. Be sure executionDate and executionTime columns are in the Date and Time format respectively. Create a new column as FinalTime with the following function =B3+C3. Apply this for the rest. Then you can use the following macro. You may need to check Tools > preferences in the VBA screen if OLEDB connection is clicked. I assumed your sheets' names as TestCases and ProgressStatus. And header of Test case name is changed as Test. You can either change them on your sheet or in macro.
Sub makro()
Dim deneme As String
Dim queryStr As String
Dim con As Object, rs As Object, sorgu$, a$
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
queryStr = "Select u.[Test]" & _
",u.[Status] " & _
"From [TestCases$] As u " & _
"Inner Join ( " & _
"Select [Test] " & _
",max(FinalTime) as [LastDate] " & _
"From [TestCases$] " & _
"Group By [Test]) As [q] " & _
"On u.Test = q.Test " & _
" And u.FinalTime = q.LastDate"
Set rs = con.Execute(queryStr)
Sheets("ProgressStatus").Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set con = Nothing
End Sub
Here is the TestCases and ProgressStatus-with results- sheets I worked on.

How to assign password to secure string in VB Script

I have a script comprising of batch files that generate powershell scripts. I've taken it upon myself to accomplish the same task via VB Script. So far I've assigned most of the info I need to strings. But I would like to have a prompt for a password that is stored as a secure string and can be outputted to a text file for later use in further scripts. So far the only code I've found doesn't work I think perhaps because it was intended for VB rather than VBS. Any help greatly appreciated.
The powershell code previously used was.
echo Please enter admin credentials (This will be stored in a secure string:
powershell -Command "& { read-host -assecurestring | convertfrom- securestring | out-file C:\S3BS\reports\input.txt; } "
You can use this small code with powershell and batch
#ECHO OFF
Title Type a password with powershell and batch
:CheckPassword
Mode con cols=50 lines=3
cls & color 0A & echo.
set MyPassword=Hackoo
set "psCommand=powershell -Command "$pword = read-host 'Enter your password' -AsSecureString ; ^
$BSTR=[System.Runtime.InteropServices.Marshal]::SecureStringToBSTR($pword); ^
[System.Runtime.InteropServices.Marshal]::PtrToStringAuto($BSTR)""
for /f "usebackq delims=" %%p in (`%psCommand%`) do set password=%%p
if %MyPassword%==%password% (Goto:Good) else (Goto:Bad)
exit/b
::***********************************************************************************************
:Good
Cls & Color 0A
echo(
echo Good Password
TimeOut /T 2 /NoBreak>nul
Exit
::***********************************************************************************************
:Bad
Cls & Color 0C
echo(
echo Bad password
TimeOut /T 1 /NoBreak>nul
Goto:CheckPassword
::***********************************************************************************************
I think this function PasswordBox can help you, just give a try ;)
' Just an example of how to use the function
'
wsh.echo "You entered: ", _
Join(PasswordBox("Enter UID and password", _
"Testing"), ", ")
' A function to present a Password dialog in a VBS (WSF)
' script
' Requires WScript version 5.1+
' Tom Lavedas <tlavedas#hotmail.com>
' with help from and thanks to Joe Ernest and
' Michael Harris
'
' modified 1/2008 to handle IE7
'
Function PasswordBox(sPrompt,sDefault)
set oIE = CreateObject("InternetExplorer.Application")
With oIE
' Configure the IE window
.RegisterAsDropTarget = False
.statusbar = false : .toolbar = false
.menubar = false : .addressbar = false
.Resizable = False
.Navigate "about:blank"
Do Until .ReadyState = 4 : WScript.Sleep 50 : Loop
' Test for IE 7 - cannot remove 'chrome' in that version
sVersion = .document.parentWindow.navigator.appVersion
if instr(sVersion, "MSIE 7.0") = 0 Then .FullScreen = True
.width = 400 : .height = 270
' Create the password box document
With .document
oIE.left = .parentWindow.screen.width \ 2 - 200
oIE.top = .parentWindow.screen.height\ 2 - 100
.open
.write "<html><head><" & "script>bboxwait=true;</" _
& "script><title>Password _</title></head>"_
& "<body bgColor=silver scroll=no " _
& "language=vbs style='border-" _
& "style:outset;border-Width:3px'" _
& " onHelp='window.event.returnvalue=false" _
& ":window.event.cancelbubble=true'" _
& " oncontextmenu=" _
& "'window.event.returnvalue=false" _
& ":window.event.cancelbubble=true'" _
& " onkeydown='if ((window.event.keycode>111)"_
& " and (window.event.keycode<117)) or" _
& " window.event.ctrlkey then" _
& " window.event.keycode=0" _
& ":window.event.cancelbubble=true" _
& ":window.event.returnvalue=false'" _
& " onkeypress='if window.event.keycode=13" _
& " then bboxwait=false'><center>" _
& "<div style='padding:10px;background-color:lightblue'>" _
& "<b>&nbsp" & sPrompt & "<b>&nbsp</div><p>" _
& "<table bgcolor=cornsilk cellspacing=10><tr><td>" _
& " <b>User:</b></td><td>" _
& "<input type=text size=10 id=user value='" _
& sDefault & "'>" _
& "</td><tr><td> <b>Password:</b></td><td>" _
& "<input type=password size=12 id=pass>" _
& "</td></tr></table><br>" _
& "<button onclick='bboxwait=false;'>" _
& " Okay " _
& "</button> <button onclick=" _
& "'document.all.user.value=""CANCELLED"";" _
& "document.all.pass.value="""";" _
& "bboxwait=false;'>Cancel" _
& "</button></center></body></html>"
.close
Do Until .ReadyState = "complete" : WScript.Sleep 100 : Loop
.all.user.focus
.all.user.select ' Optional
oIE.Visible = True
CreateObject("Wscript.Shell")_
.Appactivate "Password _"
PasswordBox = Array("CANCELLED")
On Error Resume Next
Do While .parentWindow.bBoxWait
if Err Then Exit Function
WScript.Sleep 100
Loop
oIE.Visible = False
PasswordBox = Array(.all.user.value, _
.all.pass.value)
End With ' document
End With ' IE
End Function
If you are executing the VBScript via cscript.exe something like;
cscript.exe /nologo "test.vbs"
You can use the WScript object to access the StdIn (for input) and StdOut (for output) streams to the command window using a script like this;
Function PromptForInput(prompt)
Dim prog : prog = WScript.Fullname
If LCase(Right(prog, 12)) = "\cscript.exe" Then
Call WScript.StdOut.WriteLine(prompt & " ")
PromptForInput = WScript.StdIn.ReadLine()
Else
Call Err.Raise(vbObjectError + 5, "Must be called from cscript.exe")
End If
End Function
Dim input
input = PromptForInput("Did you wish to continue? [Y/N]")
Select Case UCase(input)
Case "Y", "N"
Call WScript.StdOut.Writeline("You chose: " & UCase(input))
Case Else
Call WScript.StdOut.Writeline("Invalid option!")
End Select
Output:
Did you wish to continue? [Y/N]
y
You chose: Y
You can adapt it to prompt for passwords but be aware that the input is not hidden so all the characters typed are visible in the command window until it's closed.

how to specify database user credentials in a connection array string (Excel VBA)

Please help in modifying the connection array string (Excel 2010) to be able to receive the input from a cell reference for fields UID=;PWD= and Initial Catalog.
.Connection= Array("OLEDB;Provider=MSDASQL.1;Persist Security Info=True;Extended Properties=""DSN=NZSQL;Database=consumerdb;Servername=192.54.97.102;", "UID=USERNAME;PWD=****;Port=5480;ReadOnly=0;SQLBitOneZero=0;LegacySQLTables=0;NumericAsChar=0;ShowSystemTables=0;LoginTimeout=0;QueryTimeout=0;DateFormat=1;SecurityLevel=preferredUnSecured;CaCertFile="";Initial Catalog=CONSUMERDB_USERNAME")
The Connection string is an array of simple strings. You need to locate the one containing the user name and password, then break that section apart and insert the values from the cell. Put sections of the connection string on different lines to help break it up. Break up each section if it helps to isolate the substring that you want to manipulate.
.Connection = Array("OLEDB;Provider=MSDASQL.1;Persist Security Info=True;" & _
"Extended Properties=""DSN=NZSQL;Database=consumerdb;Servername=192.54.97.102;", _
"UID=USERNAME;PWD=****;" & _
"Port=5480;ReadOnly=0;SQLBitOneZero=0;LegacySQLTables=0;NumericAsChar=0;" & _
"ShowSystemTables=0;LoginTimeout=0;QueryTimeout=0;DateFormat=1;" & _
"SecurityLevel=preferredUnSecured;CaCertFile="";Initial Catalog=CONSUMERDB_USERNAME" _
)
Now if is easy to find the username and password and concatenate the values into that portion.
Dim usr As String, pwd As String
usr = Range("A1").Value
pwd = Range("B1").Value
.Connection = Array("OLEDB;Provider=MSDASQL.1;Persist Security Info=True;" & _
"Extended Properties=""DSN=NZSQL;Database=consumerdb;Servername=192.54.97.102;", _
"UID=" & usr & ";PWD=" & pwd & ";" & _
"Port=5480;ReadOnly=0;SQLBitOneZero=0;LegacySQLTables=0;NumericAsChar=0;" & _
"ShowSystemTables=0;LoginTimeout=0;QueryTimeout=0;DateFormat=1;" & _
"SecurityLevel=preferredUnSecured;CaCertFile="";Initial Catalog=CONSUMERDB_USERNAME" _
)

Resources