I am kind of a newbie with VBA. I have this routine that has three recordsets. The first two will get the part number and the date, the last one will give the OH inventory for that date and part number. I then use the three variables in an append query to create an inventory table per day. I am getting stuck while opening the third recordset, as I am coming up with no records, but I know that there is OH inventory for the first item on the first date. Here is the definition of the SQL string with the variables:
StrSQL2 = " SELECT top 1 "
StrSQL2 = StrSQL2 & " dbo_ViewQtStock.KIPRODMAG, "
StrSQL2 = StrSQL2 & " dbo_ViewQtStock.DTTRANS, "
StrSQL2 = StrSQL2 & " dbo_ViewQtStock.QTSTOCK "
StrSQL2 = StrSQL2 & " FROM dbo_ViewQtStock "
StrSQL2 = StrSQL2 & " WHERE (((dbo_ViewQtStock.KIPRODMAG)=" & KIPRODMAG & ") "
StrSQL2 = StrSQL2 & " AND ((dbo_ViewQtStock.DTTRANS)<='" & DTTRANS & "')) "
StrSQL2 = StrSQL2 & " ORDER BY dbo_ViewQtStock.DTTRANS DESC "
The part number KIPRODMAG is defined as an integer and the date DTTRANS as string (varchar type on server). I used the Debug.Print to he me figure some things out:
Debug.Print DTTRANS = 20130501
Debug.Print KIPRODMAG = 1
Debug.Print StrSQL2 =
SELECT top 1
dbo_ViewQtStock.KIPRODMAG,
dbo_ViewQtStock.DTTRANS,
dbo_ViewQtStock.QTSTOCK
FROM dbo_ViewQtStock
WHERE (((dbo_ViewQtStock.KIPRODMAG)=0)
AND ((dbo_ViewQtStock.DTTRANS)<=''))
ORDER BY dbo_ViewQtStock.DTTRANS DESC
I cannot unerstand why it assigns null in lieu of 20130501 and 0 in lieu of 1. Can anyone out there help me figure this out?
In case it is required, here is the complete routine:
Option Compare Database
Public Sub Stock1()
Dim cnn1 As ADODB.Connection
Dim cnn2 As ADODB.Connection
Dim cnn3 As ADODB.Connection
Set cnn1 = CurrentProject.Connection
Set cnn2 = CurrentProject.Connection
Set cnn3 = CurrentProject.Connection
Dim RS_IPRODMAG As New ADODB.Recordset
Dim RS_Date As New ADODB.Recordset
Dim RS_Stock As New ADODB.Recordset
RS_IPRODMAG.ActiveConnection = cnn1
RS_Date.ActiveConnection = cnn2
RS_Stock.ActiveConnection = cnn3
Dim StrSQL0 As String
Dim StrSQL1 As String
Dim StrSQL2 As String
Dim StrSQL3 As String
Dim DTTRANS As String
Dim KIPRODMAG As Integer
Dim QTSTOCK As Integer
'_____________________________________________________________________________
'RS_IPRODMAG
StrSQL0 = " SELECT "
StrSQL0 = StrSQL0 & " dbo_IPRODMAG.KIPRODMAG "
StrSQL0 = StrSQL0 & " FROM dbo_IPRODMAG "
StrSQL0 = StrSQL0 & " INNER JOIN dbo_VIProduit "
StrSQL0 = StrSQL0 & " ON dbo_IPRODMAG.KIPRODUIT = dbo_VIProduit.KIPRODUIT "
StrSQL0 = StrSQL0 & " WHERE (((dbo_VIProduit.flstock)=1) "
StrSQL0 = StrSQL0 & " AND ((dbo_VIProduit.fllocation)=1)) "
StrSQL0 = StrSQL0 & " ORDER BY dbo_IPRODMAG.KIPRODUIT "
'_____________________________________________________________________________
'RS_Date
StrSQL1 = " SELECT dbo_View_ITrans_Periodes.DTTRANS "
StrSQL1 = StrSQL1 & " FROM dbo_View_ITrans_Periodes "
StrSQL1 = StrSQL1 & " WHERE (((dbo_View_ITrans_Periodes.noannee)=2014)) "
'_____________________________________________________________________________
'RS_Stock
StrSQL2 = " SELECT top 1 "
StrSQL2 = StrSQL2 & " dboViewQtStock.KIPRODMAG, "
StrSQL2 = StrSQL2 & " dboViewQtStock.DTTRANS, "
StrSQL2 = StrSQL2 & " dboViewQtStock.QTSTOCK "
StrSQL2 = StrSQL2 & " FROM dboViewQtStock "
StrSQL2 = StrSQL2 & " WHERE (((dboViewQtStock.KIPRODMAG)=" & KIPRODMAG & ") "
StrSQL2 = StrSQL2 & " AND ((dboViewQtStock.DTTRANS)<='" & DTTRANS & "')) "
StrSQL2 = StrSQL2 & " ORDER BY dboViewQtStock.DTTRANS DESC "
'______________________________________________________________________________
'Append to STOCK
StrSQL3 = " INSERT INTO STOCK ( KIPRODMAG, DTTRANS, QTSTOCK ) "
StrSQL3 = StrSQL3 & " SELECT "
StrSQL3 = StrSQL3 & " & KIPRODMAG & ", "
StrSQL3 = StrSQL3 & " '" & DTTRANS & "'" & ", "
StrSQL3 = StrSQL3 & " '" & QTSTOCK & "'" & " "
'_____________________________________________________________________________
'Open recordset RS_IPRODMAG
RS_IPRODMAG.Open StrSQL0
RS_IPRODMAG.MoveFirst
'_____________________________________________________________________________
'Start of loop #1
Do While Not RS_IPRODMAG.EOF
KIPRODMAG = RS_IPRODMAG.Fields(0).Value
'_____________________________________________________________________________
'Open recordset RS_Date
RS_Date.Open StrSQL1
RS_Date.MoveFirst
'____________________________________________________________________________
'Start of loop #2
Do While Not RS_Date.EOF
DTTRANS = RS_Date.Fields(0).Value
'_________________________________________________________________________________
'Open recordset RS_STOCK
Debug.Print DTTRANS
Debug.Print KIPRODMAG
Debug.Print StrSQL2
DoCmd.RunCommand acCmdDebugWindow
RS_Stock.Open StrSQL2
QTSTOCK = RS_Stock.Fields(2).Value
'_____________________________________________________________________________________
'Append table STOCK
DoCmd.RunSQL StrSQL3
RS_Stock.Close
RS_Date.MoveNext
Loop
end of loop #2
'_____________________________________________________________________________________
RS_Date.Close
RS_IPRODMAG.MoveNext
Loop
'END of loop #1
'______________________________________________________________________________________
RS_IPRODMAG.Close
cnn1.Close
End Sub
You never give values your variables. You need to do this:
...
Dim KIPRODMAG As Integer
Dim QTSTOCK As Integer
DTTRANS = "20130501"
KIPRODMAG = 1
....
This is a debug statement which will print in your debug window:
Debug.Print DTTRANS = 20130501
Debug.Print KIPRODMAG = 1
It will tell you whether the statement reseolves to true or false, not set your variable values.
Related
I'm trying to insert a record (ID, YEAR, MONTH, VALUE) in the database, using an excel file, but if that record exists (with the same or different value) it should pop up a message saying that it already exists and if the user would like to replace it. How can I use the VALUE stored in the db, that I would like (or not) to replace, on the message box?
(...)
If has_permission Then
Set conn = New ADODB.Connection
Set rsUpdate = New ADODB.Recordset
conn.Open sConnString
Set rsUpdate = conn.Execute("SELECT ID FROM dbo.VALORES WHERE ID = " & sID & " AND YEAR = " & sYEAR & " AND MONTH = " & sMONTH & ";")
If Not rsUpdate.EOF And Not rsUpdate.BOF Then
result_msgbox = MsgBox("This record already exists with the value _DB.VALUE HERE_ . Would you like to replace it?", vbYesNo)
If result_msgbox = 6 Then
Set rsUpdate = conn.Execute("UPDATE dbo.VALORES SET VALUE = " & sVALUE & " WHERE ID = " & sID & " AND YEAR = " & sYEAR & " AND MONTH = " & sMONTH & ";")
.Cells(iRowNo, 6).Value = "Record replaced"
End If
GoTo linha_processada
End If
(...)
add value on select statement. then retrieve later. try this. its not tested
If has_permission Then
Set conn = New ADODB.Connection
Set rsUpdate = New ADODB.Recordset
conn.Open sConnString
Set rsUpdate = conn.Execute("SELECT ID, Value FROM dbo.VALORES WHERE ID = " & sID & " AND YEAR = " & sYEAR & " AND MONTH = " & sMONTH & ";")
If Not rsUpdate.EOF And Not rsUpdate.BOF Then
result_msgbox = MsgBox("This record already exists with the value " & rsUpdate.Value & " . Would you like to replace it?", vbYesNo)
If result_msgbox = 6 Then
Set rsUpdate = conn.Execute("UPDATE dbo.VALORES SET VALUE = " & sVALUE & " WHERE ID = " & sID & " AND YEAR = " & sYEAR & " AND MONTH = " & sMONTH & ";")
.Cells(iRowNo, 6).Value = "Record replaced"
End If
GoTo linha_processada
End If
UPDATE
I've managed to find a solution for my problem by using rsUpdate.Fields(i).Value.
If has_permission Then
Set conn = New ADODB.Connection
Set rsUpdate = New ADODB.Recordset
conn.Open sConnString
Set rsUpdate = conn.Execute("SELECT ID, VALUE FROM dbo.VALORES WHERE ID = " & sID & " AND YEAR = " & sYEAR & " AND MONTH = " & sMONTH & ";")
If Not rsUpdate.EOF And Not rsUpdate.BOF Then
result_msgbox = MsgBox("This record already exists with the value " & rsUpdate.Fields(2).Value & " . Would you like to replace it?", vbYesNo)
If result_msgbox = 6 Then
Set rsUpdate = conn.Execute("UPDATE dbo.VALORES SET VALUE = " & sVALUE & " WHERE ID = " & sID & " AND YEAR = " & sYEAR & " AND MONTH = " & sMONTH & ";")
.Cells(iRowNo, 6).Value = "Record replaced"
End If
GoTo linha_processada
End If
I have some problem when inserting data to database.
I am using mssql.
Private Sub EditMethodAdd_Click()
Dim rs As ADODB.Recordset
Dim introw
Dim strState As String
Dim strsql1 As String
Dim strsql2 As String
Dim all As String
Dim strConn As String
Dim conn As ADODB.Connection
MsgBox ("EditM1.Value:" & EditM1.value)
strConn = "DRIVER=SQL Server;SERVER=CHU-AS-0004;DATABASE=RTC_LaplaceD_DEV;Trusted_Connection=Yes;"
strsql1 = " INSERT INTO dbo.Method(MethodID, MethodClass, Category, Description, Description2, MSA, ReqType, Equipment, Location, Spec1, Spec2, Spec3, Spec4, Spec5, Spec6, PilotingYN) "
strsql2 = " VALUES(EditM1.value, 'Piloting', EditM3.value, Null, Null, Null, Null, EditM2.value, EditM4.value, EditM5.value, EditM6.value, EditM7.value, EditM8.value, EditM9.value, EditM10.value, Null )"
all = strsql1 & strsql2
MsgBox ("ALL" & all)
Set conn = New ADODB.Connection
conn.Open strConn
Set rs = New ADODB.Recordset
rs.Open all, conn
MsgBox ("Insert Success")
EditMethodList.Requery
conn.Close
Set rs = Nothing
Set conn = Nothing
MsgBox "Data has been updated"
EditMethodList.Requery
End Sub
When I check the value for EditM1 by using MsgBox, it shows correct.
But I got error message like this.
Is there anyone who can solve this problem?
Thank you in advance.
Delete the lines:
strsql1 = ...
strsql2 = ...
all = strsql1 & strsql2
and write this instead
all = "INSERT INTO dbo.Method(MethodID, MethodClass, Category, Description, Description2, MSA, ReqType, Equipment, Location, Spec1, Spec2, Spec3, Spec4, Spec5, Spec6, PilotingYN) "
all = all & "VALUES(" & EditM1.value & ", 'Piloting'," & EditM3.value & ", Null, Null, Null, Null," & EditM2.value & "," & EditM4.value & ","
all = all & EditM5.value & "," & EditM6.value & "," & EditM7.value & "," & EditM8.value & "," & EditM9.value & "," & EditM10.value & ", Null )"
If you insert EditM1.value into doublequotes, as you did, VBA read it as a string and it does not refer to its value. You need to concatenate string and values with & to create your query.
You're putting the literal value "EditM1.value" into your SQL: you should instead be sending the Value of the control:
strsql2 = " VALUES(" & EditM1.value & ", 'Piloting', " & _
EditM3.value & ", Null,..." 'etc
If any of the values being sent are not numeric then they should be wrapped in single quotes.
Can someone please let me know what is wrong with this code? I have checked all lines for misspellings - this isnt the issue. All tables and queries are written as they exist in the db. Any help is appreciated.
Private Sub LoadArray()
'---------------------------
'---------------------------
'This procedure loads text into the 3rd column of the array
'---------------------------
'---------------------------
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsFiltered As DAO.Recordset
Dim strSQL As String
Dim i As Integer
strSQL = "SELECT tblProperties.Name, tbl1OpportuniyType.Type, qryPropertiesALLTypesALLTbls.TotalUnits, " _
& "qryPropertiesALLTypesALLTbls.EventStartTimeEachDay, qryPropertiesALLTypesALLTbls.EventEndTimeEachDay, " _
& "qryPropertiesALLTypesALLTbls.EventStartDate, qryPropertiesALLTypesALLTbls.EventStopDate, " _
& "qryPropertiesALLTypesALLTbls.TechOpsGroup, qryPropertiesALLTypesALLTbls.TechOpsResource " _
& "FROM tbl1OpportuniyType RIGHT JOIN (qryPropertiesALLTypesALLTbls INNER JOIN tblProperties ON qryPropertiesALLTypesALLTbls.[PropertyComplex_ID] = tblProperties.[PropertyComplex_ID]) ON tbl1OpportuniyType.[OpportunityType_ID] = tblProperties.OpportunityType " _
& "WHERE (((qryPropertiesALLTypesALLTbls.EventStartDate) Is Not Null));"
'Debug.Print strSQL
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
'This line ensures that the recordset is populated
If Not rs.BOF And Not rs.EOF Then
'Loops through the Array using dates for the filter
For i = LBound(myArray) To UBound(myArray)
If myArray(i, 1) Then
'Filters recordset with array dates
rs.Filter = "[EventStartDate]= " & myArray(i, 0)
'Open up new recordset based on filter
Set rsFiltered = rs.OpenRecordset
'Loop through new recordset
Do While (Not rsFiltered.EOF)
'Adds text to the 3rd column of the array
myArray(i, 2) = myArray(i, 2) & vbNewLine _
& rsFiltered!Type & " - " & vbNewLine _
& rsFiltered!Name & " " _
& rsFiltered!EventStartDate & " - " _
& rsFiltered!EventStopDate & " " _
& rsFiltered!EventStartTimeEachDay & " - " _
& rsFiltered!TechOpsGroup & " " _
& rsFiltered!TechOpsResource & " " _
& vbNewLine
rsFiltered.MoveNext
Loop
End If
Next i
End If
rsFiltered.Close
rs.Close
'Sets objects to nothing
Set rsFiltered = Nothing
Set rs = Nothing
Set db = Nothing
End Sub
It isn't clear where myArray comes from, but the filter needs an adjustment to convert the date value to a string expression:
rs.Filter = "[EventStartDate] = #" & Format(myArray(i, 0), "yyyy\/mm\/dd") & "#"
I am opening an SQL Server Connection in EXCEL VBA and on the objMyCmd.Execute line when it is using the SQL script I am getting this error message:
"Run-time error '-2147217900 (80040e14)') Automation error"
I have reviewed other SO posts that seem to reference an issue with the connection string itself, but I don't believe that is the issue as I am able to pull the first few variables listed when eliminating the rest of the SQL script.
I have attempted to review the SQL code to see if I am using an incorrect format, or if the language is not written properly and I am not able to determine the issue. I am hoping with some Q & A we may notice something I have missed in how this is written? Please let me know if there is additional information I can provide, below is the code up to the point of error.
Sub SQL_GetAgentChart()
Dim dtDate As Date
Dim myTable As ListObject
Dim DataServer As String
Dim Database As String
Dim constring As String
DataServer = "GLSSQLMADP2"
Database = "PERF_MGMT_BWRSRV_PROD"
constring = "Driver={SQL Server};Server=" & DataServer & "; Database=" & Database & "; Trusted_Connection=yes"
Dim AVStartDate As Date
Dim AVEndDate As Date
Dim RepID As Long
'Declare variables'
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
Set myTable = Worksheets("Witness").ListObjects("tblWitness")
AVStartDate = DateValue("Mar 01, 2016")
AVEndDate = DateValue("Mar 31, 2016")
RepID = 2040
'Open Connection'
objMyConn.ConnectionString = constring
objMyConn.Open
'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyConn
objMyCmd.CommandText = " " & _
"SELECT PERSN_XTRNL_ID_NR, SOURCE, LOGGINGTS, DD7, CUREREASON, CUREDATE, LNSTATUS " & _
"FROM TTB " & _
"WITH INCALL AS (SELECT T.CUREREASON, CUREVALUE " & _
"FROM TTB T " & _
"JOIN PERSONNEL P ON T.PERSONNELID = P.PERSONNELID " & _
"LEFT JOIN CURETRANSLATE C ON T.CUREREASON = C.CUREREASON AND T.LNSTATUS = C.STATUS " & _
"WHERE T.PERSONNELID = " & RepID & " " & _
"AND LOGGINGTS > '" & AVStartDate & "' " & _
"AND LOGGINGTS < '" & AVEndDate + 1 & "' " & _
"AND INCOMING = 1 " & _
"AND DD7 > 0), OUTCALL AS (SELECT T.CUREREASON, CUREVALUE " & _
"FROM TTB T " & _
"JOIN AVAYA A ON T.UID = A.TTBUID " & _
"LEFT JOIN CURETRANSLATE C ON T.CUREREASON = C.CUREREASON AND T.LNSTATUS = C.STATUS " & _
"WHERE PERSONNELID = " & RepID & " " & _
"AND LOGGINGTS > '" & AVStartDate & "' " & _
"AND LOGGINGTS < '" & AVEndDate + 1 & "' " & _
"AND INCOMING = 0 " & _
"AND A.AVAYAGROUP IN ('15', '1A', '1B', '1C', '1D', '1E', '1F', '1G', '1H') " & _
"AND DD7 > 0) "
objMyCmd.CommandType = adCmdText
objMyCmd.Execute
I have done a bit of work on my code, and still unsure about how some of the code needs to be done in order to work.
So far I got a function named FunctionUp' coded, this is the code that will go in the following sequence:
If array of orders contains:
'A1G722
'A1G723
'A1G724
'A1G725
'A1G726
'A1G727
I added a reference to the current location as a query-string parameter named rowindex, so if the order passed in query-string is 'A1G725', the row index value will be 4, then function code will ideally browse in this sequence: 'A1G725', 'A1G724', 'A1G723', 'A1G722'
The code for the button:
.Write "<input type='submit' name='btnUp' value='Next' class='buttonRight' />"
The code that calls the function:
If Request("btnUp") = "Next" Then Call FuctionUp()
The code for the function:
Function FuctionUp()
Dim objConn
Dim objRS
Dim SQLOrderList
Dim SQLCurrentOrder
Dim currentorder
Dim previousorder
Dim sortby
Dim dtstart
Dim dtend
Dim index
currentorder = Trim(Request.QueryString("order"))
sortby = Request.QueryString("sortby")
currentorder = Request.QueryString("order")
dtstart = Request.QueryString("start")
dtend = Request.QueryString("end")
Set objRS = Server.CreateObject("ADODB.Recordset")
Set objConn = CreateObject("ADODB.Connection")
objConn.Open Application("conn_AWDSTAGE")
objRS.Cursortype = 3
SQLOrderList = "SELECT orderno" & _
" FROM _order" & _
" WHERE order_date >= '" & dtstart & "'" & _
" AND order_date < '" & dtend & "'" & _
" ORDER BY " & sortby
objRS.Open SQLOrderList, objConn
index = CINT(Request.QueryString("rowindex"))
If Not isNumeric(index) Or index = "" Then
index = 0
End If
'Get this to Array.
Dim iArray
Dim i
Dim sizeOfiArray
iArray = objRS.GetRows()
' sample of array contents after sql execution
'A1G722
'A1G723
'A1G724
'A1G725
'A1G726
'A1G727
sizeOfiArray = uBound(iArray) + 1
if not index >= (sizeOfiArray - 1) then previousorder = (index + 1)
If Not previousorder Is Nothing Then
Response.Redirect("~/printpreview.asp?order=" & previousorder(i) &
"&site=" & spiderSiteKey &
"&env=" & strEnv &
"&start=" & CDate(dtstart) &
"&end=" & CDate(dtend) &
"&rowindex=" & (index + 1) &
"&sortby=" & sortby)
Else
Response.Redirect("~/printpreview.asp?order=" & currentOrder.OrderID &
"&site=" & spiderSiteKey &
"&env=" & strEnv &
"&start=" & CDate(dtstart)) &
"&end=" & CDate(dtend) &
"&rowindex=" & (index) &
"&sortby=" & strSortBy &
"&LastRecord=Up")
End If
objRS.Close()
Set objRS = Nothing
objConn.Close()
Set objConn = Nothing
End Function
Wouldn't it be easier simply to get the next or previous orders directly from the database using SQL:
sSQLGetPrevOrder = "SELECT top(1) PREV.* " _
& " FROM [Order] PREV " _
& " JOIN ( " _
& " SELECT " & strOrderBy & " sortvalue, orderno " _
& " FROM Order WHERE orderno='" & strCurrentOrder & "' " _
& " ) CURR " _
& " ON PREV." & strOrderBy & " < CURR.sortvalue " _
& " OR ( PREV." & strOrderBy & " = CURR.sortvalue " _
& " AND PREV.orderno < CURR.orderno ) " _
& " ORDER BY PREV." & strOrderBy & " DESC, PREV.orderno DESC "
sSQLGetNextOrder = "SELECT top(1) NXT.* " _
& " FROM [Order] NXT " _
& " JOIN ( " _
& " SELECT " & strOrderBy & " sortvalue, orderno " _
& " FROM Order WHERE orderno='" & strCurrentOrder & "' " _
& " ) CURR " _
& " ON NXT." & strOrderBy & " > CURR.sortvalue " _
& " OR ( NXT." & strOrderBy & " = CURR.sortvalue " _
& " AND NXT.orderno > CURR.orderno ) " _
& " ORDER BY NXT." & strOrderBy & " ASC, NXT.orderno ASC "
(Apologies if this code has syntax errors, I have not been able to test it)
If orderno is always a number, you could omit the quote marks around strCurrentOrder.