I'm try to copy data from SQl-Server to Excel, but the result is include with headers. I want result without headers. Here my code :
ConnectionString = "Provider=SQLOLEDB;SERVER=DWSQL\User;Database=User;Uid=User;Pwd=User;"
If Sheets("Menu").Cells(4, 4) = "SC" Then
SQL = "SELECT * FROM [MVS].[dbo].[trpos_process] where fc = '2' and process = 'ASSEMBLY' and status = 'NEW'"
ElseIf Sheets("Menu").Cells(4, 4) = "MC" Then
SQL = "SELECT * FROM [MVS].[dbo].[trpos_process] where fc = '3' and process = 'ASSEMBLY' and status = 'NEW'" 'and startby is Null"
ElseIf Sheets("Menu").Cells(4, 4) = "EV" Then
SQL = "SELECT * FROM [MVS].[dbo].[trpos_process] where fc = '5' and process = 'ASSEMBLY' and status = 'NEW' and pos_no like 'EN5%'"
End If
Connection.Open ConnectionString
rs.Open SQL, Connection, adOpenStatic, adLockReadOnly
Set QT = ActiveSheet.QueryTables.Add(rs, Sheets("Data").Cells(1, 2))
QT.Refresh: rs.Close: QT.Delete: Connection.Close
Thanks.
Use CopyFromRecordset!
ConnectionString = "Provider=SQLOLEDB;SERVER=DWSQL\User;Database=User;Uid=User;Pwd=User;"
If Sheets("Menu").Cells(4, 4) = "SC" Then
Sql = "SELECT * FROM [MVS].[dbo].[trpos_process] where fc = '2' and process = 'ASSEMBLY' and status = 'NEW'"
ElseIf Sheets("Menu").Cells(4, 4) = "MC" Then
Sql = "SELECT * FROM [MVS].[dbo].[trpos_process] where fc = '3' and process = 'ASSEMBLY' and status = 'NEW'" 'and startby is Null"
ElseIf Sheets("Menu").Cells(4, 4) = "EV" Then
Sql = "SELECT * FROM [MVS].[dbo].[trpos_process] where fc = '5' and process = 'ASSEMBLY' and status = 'NEW' and pos_no like 'EN5%'"
End If
Connection.Open ConnectionString
rs.Open Sql, Connection, adOpenStatic, adLockReadOnly
Range("b2").CopyFromRecordset rs
rs.Close: QT.Delete: Connection.Close
Related
I need to import 'contacts' into my database from several external sources.
Some 'contacts' may already exist so I only need 'new' data.
I've written an update records code however it will overwrite all data therefore damaging the integrity of the table as the old data may contain some valid values.
I tried using an update/append query however this only OVERWROTE the values of the original field not UPDATED IF OLD VALUE WAS NULL/FALSE ONLY. The issue with this is it will apply/remove profile flags that result in correspondence and data usage (Incorrect update = potential breach of GDPR).
I can't program in SQL, I understand how the functions work and what they do but not how to compile/what order (yet) hence using VBA for now.
Dim myR As Recordset
Dim myR2 As Recordset
Set myR = CurrentDb.OpenRecordset("Staging - Import", dbOpenDynaset)
Set myR2 = CurrentDb.OpenRecordset("Contacts", dbOpenDynaset)
Do Until myR.EOF = True
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![Website] = myR![Website]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Surpress]
myR2.Update
Else
myR2.Edit
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![Website] = myR![Website]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Surpress]
myR2.Update
End If
myR.MoveNext
Loop
Set myR = Nothing
End Sub
Is there a simpler way to write this or should I be utilising the code
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
For each value, creating effectively 15-20 subs and a macro to run all together?
I tried several code variations attempting to include elseIf, isNull() and isFalse() however they always failed to compile or no update was completed/records changed.
I need the code to do the following:
Check the contact exists in contacts table
If contact does not exist, add all data
If contact does exist, add new data or update yes/no fields from no to yes
NOTE: Currently 'contacts' table is empty as we need to create new/merge duplicates before the data is imported to the 'contacts' table.
So Contacts is currently:
Email Name Surname
- - -
- - -
- - -
- - -
Staging - Import is currently:
Email Name Surname
b#b.c Brad
t#b.c Tony Tiger
b#b.c B Pitt
r#b.c Ryan Reynolds
Contacts should look like this after completed:
Email Name Surname
t#b.c Tony Tiger
b#b.c Brad Pitt
r#b.c Ryan Reynolds
Determining what to update or add when comparing string data can be quite complicated and often involves case-by-case review. What rule should be applied to program decision to take "Brad" from one record and "Pitt" from other? What if data for the same email were: Brad Pitt and Bradley Pitt? Which is correct and should be saved? Probably have to do a query that finds duplicate emails in Staging and make case-by-case decision on what to fix/delete for these duplicates. Then insert to Contacts. Insert code can test content of each field for Null or False and determine whether to accept new value.
For non-yes/no field, use Nz() function (assumes text field will not have empty string)
myR2![First Name] = Nz(myR2![First Name], myR![First Name])
or (to deal with possible empty string)
If myR2![First Name] & "" = "" Then myR2![First Name] = myR![First Name]
(advise not to allow empty string in text field nor zero default value for number field in table design).
For yes/no field, test for False (do not set DefaultValue property in table design):
myR2![Supress] = IIf(myR2![Supress] = False, myR![Supress], True)
or
If myR2![Supress] = False Then myR2![Supress] = myR![Supress]
Shorter code for import procedure. Modify with the above.
Do Until myR.EOF = True
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
Else
myR2.Edit
End If
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![WebSite] = myR![WebSite]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Supress]
myR2.Update
myR.MoveNext
Loop
Another, assuming recordsets have exactly same fields.
Dim myR As DAO.Recordset
Dim myR2 As DAO.Recordset
Dim fld As DAO.Field
Set myR = CurrentDb.OpenRecordset("Staging - Import", dbOpenDynaset)
Set myR2 = CurrentDb.OpenRecordset("Contacts", dbOpenDynaset)
Do Until myR.EOF = True
myR2.FindFirst "Email = '" & myR![Email] & "'"
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
Else
myR2.Edit
End If
For Each fld In myR.Fields
If fld.Name <> "Email" And _
(myR2.Fields(fld.Name) & "" = "" Or myR2.Fields(fld.Name) = False) Then
myR2.Fields(fld.Name) = fld
End If
Next
myR2.Update
myR.MoveNext
Loop
To get started I created a program at work to read our network tools and store the retrieved data to our database. No problem but the way I set it up originally was every tool had its own instance and was hard coded for each tool.
Now I was tasked with making the program more user friendly so I can send it to other places. So now I database the IP address of tool and location on assembly line so I can cross reference while the code is executing.
On the new program I created an array of my Tool Reader class:
Dim TB(50) As ReadAtlascopco
Then I run through this loop on form load:
Private dict As New Dictionary(Of Timer, Label)()
Private Sub CreateTimers()
For i = 0 To IPCount
TB(i) = New ReadAtlascopco
' timer(i) = New Timerarray
Next
For i As Integer = 1 To IPCount
C = i - 1
timer = New Timer() With {.Interval = 250, .Enabled = True, .Tag = i.ToString}
AddHandler timer.Tick, (AddressOf timer_Tick)
' timer.Interval = (100 * i)
label = New Label()
label.Name = "label" & i
label.Location = New Point(10, 10 + i * 25)
label.Font = New Font("Sans Serif", 9, FontStyle.Bold)
label.AutoSize = True
'label.Width = 100
'label.AutoEllipsis = False
label.TabIndex = i
label.Visible = True
Me.Controls.Add(label)
dict(timer) = label
TB(C).ipaddress = TBData(C)
TB(C).StartConnection()
timer.Enabled = True
timer.Start()
Next
Then I go through the timer tick event. Everything works great up until this point. Once I go through the tick event it starts lagging and I miss data.
Is there a way to speed this process up?
Here is the tick event:
Private Sub timer_Tick(ByVal sender As Object, ByVal e As EventArgs)
Dim Stop_Num(50) As String
Dim Line_Name(50) As String
Dim t As Timer = DirectCast(sender, Timer)
Dim s As Integer = Val(t.Tag) - 1
Param1 = TBData(s)
CWE(s) = False
If Activestat(s) = True Then
Dim SQL1 As String = "SELECT Stop_Num FROM TBL_Added_Boxes Where(IP_Address = N'" + Param1 + "')"
Dim output1 As String
Using cn = New SqlConnection(My.Settings.Torque_InfoConnectionString)
Using cmd = New SqlCommand(SQL1, cn)
cn.Open()
Try
Dim dr1 = cmd.ExecuteReader()
While dr1.Read()
output1 = dr1("Stop_Num").ToString()
End While
Catch ex As SqlException
WriteToErrorLog("Error pulling data from the database in reguards to torque box info (Stop Number).", ex.ToString(), "Failed to retreive Torque controler Info .")
End Try
cn.Close()
End Using
End Using
Stop_Num(0) = output1
Dim SQL2 As String = "SELECT Line_On FROM TBL_Added_Boxes Where(IP_Address = N'" + Param1 + "')"
Dim output2 As String
Using cn = New SqlConnection(My.Settings.Torque_InfoConnectionString)
Using cmd = New SqlCommand(SQL2, cn)
cn.Open()
Try
Dim dr2 = cmd.ExecuteReader()
While dr2.Read()
output2 = dr2("Line_On").ToString()
End While
Catch ex As SqlException
WriteToErrorLog("Error pulling data from the database in reguards to torque box info (Line On).", ex.ToString(), "Failed to retreive Torque controler Info .")
End Try
cn.Close()
End Using
End Using
Line_Name(0) = output2
If Line_Name(0) = "Line 1" Then
Newlinename(s) = "Line1Serial"
ElseIf Line_Name(0) = "Line 2" Then
Newlinename(s) = "Line2Serial"
ElseIf Line_Name(0) = "Line 3" Then
Newlinename(s) = "Line3Serial"
End If
Param3 = Stop_Num(0)
Param2 = Newlinename(s)
Dim SQL As String = "SELECT " + Newlinename(s) + " FROM TBL_RunningLineStatus Where(Stop_Number = N'" + Stop_Num(0) + "')"
Dim output As String
Using cn = New SqlConnection(My.Settings.ScanBypassConnectionString)
Using cmd = New SqlCommand(SQL, cn)
cn.Open()
Try
Dim dr = cmd.ExecuteReader()
While dr.Read()
output = dr(Param2).ToString()
End While
Catch ex As SqlException
WriteToErrorLog("Error Pulling Data From The Database In reguards to Seat Data.", ex.ToString(), "Failed to retreive buildline data.")
End Try
cn.Close()
End Using
End Using
TBSData(s) = output
If Killall = "True" Then
t.Stop()
Else
Try
TB(s).GetData()
If TB(s).Colorselect = 0 Then
dict(t).BackColor = System.Drawing.Color.GreenYellow
dict(t).ForeColor = Color.Black
ElseIf TB(s).Colorselect = 1 Then
TB(s).ipaddress = TBData(s)
TB(s).StartConnection()
dict(t).BackColor = System.Drawing.Color.Red
dict(t).ForeColor = Color.White
ElseIf TB(s).Colorselect = 2 Then
dict(t).BackColor = System.Drawing.Color.Purple
dict(t).ForeColor = Color.White
End If
If Olddata(s) <> TB(s).TorboxData(20) Then
Cname(s) = TB(s).TorboxData(2)
Tstatus(s) = TB(s).TorboxData(7)
TValue(s) = TB(s).TorboxData(19)
Sdata(s) = TBSData(s)
Tfinal(s) = TB(s).TorboxData(18)
TPset(s) = TB(s).TorboxData(30)
TFinalAngle(s) = TB(s).TorboxData(24)
RDAmin(s) = TB(s).TorboxData(25)
RDAmax(s) = TB(s).TorboxData(26)
RDAactual(s) = TB(s).TorboxData(27)
RDAStat(s) = TB(s).TorboxData(15)
Anglemin(s) = TB(s).TorboxData(21)
Anglemax(s) = TB(s).TorboxData(22)
AngleFT(s) = TB(s).TorboxData(23)
Anglestat(s) = TB(s).TorboxData(13)
Tormin(s) = TB(s).TorboxData(16)
Tormax(s) = TB(s).TorboxData(17)
TTTights(s) = TB(s).TorboxData(28)
TTSerial(s) = TB(s).TorboxData(29)
Olddata(s) = TB(s).TorboxData(20)
CWE(s) = True
dict(t).Text = t.Tag + " ) " + "Controler Name : " + TB(s).TorboxData(2) + ": Status : " + TB(s).Connectiontext + " : Date : " + Now() + " :: SERIAL # : " + Sdata(s) + " : From : " + Newlinename(s) + " :: Stop : " + Param3 + ""
' .Text = t.Tag + " ) " + "Controler Name : " + TB(s).TorboxData(2) + ": Status : " + TB(s).Connectiontext + " : Date : " + Now() + " :: SERIAL # : " + Sdata(s) + " : From : " + Newlinename(s) + " :: Stop : " + Param3 + "")
dict(t).BackColor = System.Drawing.Color.Yellow
Else
If TB(s).networkconnected = True Then
dict(t).AutoSize = True
'dict(t).Text = "Controler Name : " + TB(s).TorboxData(2) + ": Status : " + TB(s).Connectiontext + " : Date : " + Now()
dict(t).BackColor = System.Drawing.Color.Yellow
dict(t).ForeColor = Color.Black
Else
dict(t).Text = TB(s).Connectiontext + " :::: " + Now() + " :: " + TBData(s)
dict(t).BackColor = System.Drawing.Color.Red
dict(t).ForeColor = Color.White
End If
End If
Catch ex As Exception
WriteToErrorLog("Error Reading the torque box .", ex.Message, "Failed read torque data.")
Finally
'If CWE(s) = True Then
' Call Data_Entry()
'End If
If TValue(s) <> "" And CWE(s) = True Then
Try
con.ConnectionString = My.Settings.ScanBypassConnectionString
con.Open()
cmd.Connection = con
cmd.CommandText = "INSERT INTO TBL_Torque_Value1 (Serial_Num, Controler_Name, Torque_Status, Torque_Value, Date_Time,Extra_1, Extra_2, Extra_3,RundownMin,RundownMax,RundownAct,RundownStat,AngleMin,AngleMax,AngleFT,AngleStat,TorqueMin,TorqueMax,ToolTightens,Toolserialnum) VALUES(#p1,#p2, #p3, #p4, #p5, #p6, #p7, #p8,#p9, #p10, #p11, #p12, #p13, #p14, #p15, #p16, #p17, #p18, #p19, #p20)"
cmd.Parameters.Add("#p1", SqlDbType.NVarChar, 50)
cmd.Parameters.Add("#p2", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p3", SqlDbType.NVarChar, 50)
cmd.Parameters.Add("#p4", SqlDbType.NVarChar, 50)
cmd.Parameters.Add("#p5", SqlDbType.DateTime2, 7)
cmd.Parameters.Add("#p6", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p7", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p8", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p9", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p10", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p11", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p12", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p13", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p14", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p15", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p16", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p17", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p18", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p19", SqlDbType.NVarChar, 250)
cmd.Parameters.Add("#p20", SqlDbType.NVarChar, 250)
cmd.Parameters("#p1").Value = Sdata(s)
cmd.Parameters("#p2").Value = Cname(s)
cmd.Parameters("#p3").Value = Tstatus(s)
cmd.Parameters("#p4").Value = TValue(s)
cmd.Parameters("#p5").Value = Now()
cmd.Parameters("#p6").Value = Tfinal(s)
cmd.Parameters("#p7").Value = TFinalAngle(s) + " Deg"
cmd.Parameters("#p8").Value = "P:" + TPset(s)
cmd.Parameters("#p9").Value = RDAmin(s)
cmd.Parameters("#p10").Value = RDAmax(s)
cmd.Parameters("#p11").Value = RDAactual(s)
cmd.Parameters("#p12").Value = RDAStat(s)
cmd.Parameters("#p13").Value = Anglemin(s)
cmd.Parameters("#p14").Value = Anglemax(s)
cmd.Parameters("#p15").Value = AngleFT(s)
cmd.Parameters("#p16").Value = Anglestat(s)
cmd.Parameters("#p17").Value = Tormin(s)
cmd.Parameters("#p18").Value = Tormax(s)
cmd.Parameters("#p19").Value = TTTights(s)
cmd.Parameters("#p20").Value = TTSerial(s)
cmd.ExecuteNonQuery()
Catch ex As Exception
WriteToErrorLog("Error Inserting Data into The Database In reguards to Torque Data.", ex.Message, "Failed to Insert Torque Data.")
con.Close()
cmd.Parameters.Clear()
Cname(s) = ""
Tstatus(s) = ""
TValue(s) = ""
Sdata(s) = ""
Tfinal(s) = ""
TFinalAngle(s) = ""
TPset(s) = ""
RDAmin(s) = ""
RDAmax(s) = ""
RDAactual(s) = ""
RDAStat(s) = ""
Anglemin(s) = ""
Anglemax(s) = ""
AngleFT(s) = ""
Anglestat(s) = ""
Tormin(s) = ""
Tormax(s) = ""
TTTights(s) = ""
TTSerial(s) = ""
Finally
con.Close()
cmd.Parameters.Clear()
Cname(s) = ""
Tstatus(s) = ""
TValue(s) = ""
Sdata(s) = ""
Tfinal(s) = ""
TFinalAngle(s) = ""
TPset(s) = ""
RDAmin(s) = ""
RDAmax(s) = ""
RDAactual(s) = ""
RDAStat(s) = ""
Anglemin(s) = ""
Anglemax(s) = ""
AngleFT(s) = ""
Anglestat(s) = ""
Tormin(s) = ""
Tormax(s) = ""
TTTights(s) = ""
TTSerial(s) = ""
End Try
End If
End Try
End If
Else
dict(t).AutoSize = True
dict(t).Text = "Torque Box is not active :: " + TBData(s) + " ::"
dict(t).BackColor = System.Drawing.Color.Black
dict(t).ForeColor = Color.White
End If
End Sub
The class that is being referenced is one that I created and is working but like I said everything is slow. It seems to hang for 3 to 5 seconds in a single tick event.
As of now I only have 21 tools setup and it will take about 15 to 30 seconds to cycle through all.
I have the following SQL/Server function defined in C# to detect when a vehicle has refuelled. I keep a context of the last fuel used so that I don't need to move a cursor back over the data:
[Microsoft.SqlServer.Server.SqlFunction]
public static SqlDouble GetFuelRefill(SqlString ID, SqlString FuelLeft)
{
object _lastID = CallContext.GetData("lastID6");
object _fuelRefill = CallContext.GetData("fuelRefill");
double fuelRefill = _fuelRefill == null ? 0.0 : Convert.ToDouble(_fuelRefill);
object _lastFuelLeft = CallContext.GetData("lastFuelLeft");
double lastFuelLeft = _lastFuelLeft == null ? 0.0 : Convert.ToDouble(_lastFuelLeft);
double result = 0.0;
if ((_lastID == null) || (Convert.ToString(_lastID) != ID.Value) || (_lastFuelLeft == null))
{
fuelRefill = 0;
CallContext.SetData("lastFuelLeft", 0.0);
}
else if (!FuelLeft.IsNull)
{
double fl = Convert.ToDouble(FuelLeft.Value);
if ((fl > 0.0) && (lastFuelLeft > 0.0) && ((fl - lastFuelLeft) / fl * 100.0 >= 5.0))
fuelRefill += fl - lastFuelLeft;
CallContext.SetData("lastFuelLeft", FuelLeft.Value);
}
result = fuelRefill;
CallContext.SetData("lastID6", ID.Value);
CallContext.SetData("fuelRefill", fuelRefill);
return new SqlDouble(result);
}
For the purpose of repeating the problem I have created a small test table:
SequenceNo AssetID FuelLeft
1 PJ1 50
2 PJ1 49
3 PJ1 48
4 PJ1 98
5 PJ1 95
Then I execute the following command from SQL/Server Management Studio:
SELECT SequenceNo,dbo.GetFuelRefill(AssetID,FuelLeft) AS Refill
FROM TestTable ORDER BY SequenceNo
Which yields the following result that I expect:
SequenceNo Refill
1 0
2 0
3 0
4 50
5 50
However then I try executing the same query using ADO from VBScript:
const DatabaseName = "MyDB"
const DatabaseServer = "(local)"
const adOpenForwardOnly = 0
const adLockOptimistic = 3
Dim FSO : set FSO = CreateObject("Scripting.FileSystemObject")
Dim Conn : Set Conn = CreateObject("ADODB.Connection")
Conn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Initial Catalog=" & DatabaseName & ";Server=" & DatabaseServer
Set Query = CreateObject("ADODB.Recordset")
Query.Open "SELECT SequenceNo,dbo.GetFuelRefill(AssetID,FuelLeft) AS Refill FROM TestTable ORDER BY SequenceNo", Conn, adOpenForwardOnly, adLockOptimistic
Set f = FSO.CreateTextFile("E:\Temp\Test.TXT", true)
do while not Query.EOF
f.WriteLine Query("SequenceNo") & ", " & Query("Refill")
Query.MoveNext
loop
Set FSO = Nothing
Query.Close
Conn.Close
The test.txt file contains the following:
1, 0
2, 0
3, 0
4, 0
5, 0
Doing some further debugging it appears that the call context isn't being saved for the duration of the query, but I wondered if anyone knows why and a way to solve it?
After further experimentation I found two solutions. One was to place the query inside a simple stored procedure such as:
CREATE PROCEDURE sp_Test
AS
BEGIN
SET NOCOUNT ON;
SELECT SequenceNo,dbo.GetFuelRefill(AssetID,FuelLeft) AS Refill
FROM TestTable ORDER BY SequenceNo
END
And the other was to change the VBS code to use a client-side cursor:
const DatabaseName = "MyDB"
const DatabaseServer = "(local)"
const adOpenForwardOnly = 0
const adLockOptimistic = 3
const adUseClient = 3
Dim FSO : set FSO = CreateObject("Scripting.FileSystemObject")
Dim Conn : Set Conn = CreateObject("ADODB.Connection")
Conn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Initial Catalog=" & DatabaseName & ";Server=" & DatabaseServer
Set Query = CreateObject("ADODB.Recordset")
Query.CursorLocation = adUseClient
Query.Open "SELECT SequenceNo,dbo.GetFuelRefill(AssetID,FuelLeft) AS Refill FROM TestTable ORDER BY SequenceNo", Conn, adOpenForwardOnly, adLockOptimistic
Set f = FSO.CreateTextFile("E:\Temp\Test.TXT", true)
do while not Query.EOF
f.WriteLine Query("SequenceNo") & ", " & Query("Refill")
Query.MoveNext
loop
Set FSO = Nothing
Query.Close
Conn.Close
I want to create a multidimensional array with 2 columns and have the row size a dynamic value. I then want to populate the multidimensional array with values from 2 different SQL queries (Microsoft).
The problem is That when the page loads it seems to be empty. How can Fill each column with he two different recordsets?
Or
At least return the total number of rows in the recordset?
Code below -
connectionstring = obj_ADO.getconnectionstring
Set objCon = CreateObject("ADODB.Connection")
Set objRS = CreateObject("ADODB.Recordset")
set objComm = CreateObject("ADODB.Command")
objCon.Open connectionstring
objComm.ActiveConnection = objCon.ConnectionString
objComm.CommandText = "A_Page_Paging"
objComm.CommandType = adCmdStoredProc
Set objParameter = objComm.CreateParameter
objParameter.Name = "selected_Char"
objParameter.Type = adChar
objParameter.Direction = adParamInput
objParameter.Size = 3
objParameter.Value = Selected_Button
objComm.Parameters.Append objParameter
set objRS = objComm.Execute
Increment = 0
Dim testArray()
while not objRS.EOF
Redim testArray(2, increment)
'--------------------------------------------
Page_ID = objRS("P_PageID")
connectionstring = obj_ADO.getconnectionstring
Set objConn = CreateObject("ADODB.Connection")
Set objRSS = CreateObject("ADODB.Recordset")
objConn.Open connectionstring
SQL = "Select P_Name as P_Name, P_Description as P_Description from L_PagePermission inner join A_Permission on p_permissionID = pp_PermissionID inner join A_Page on P_PageID = PP_PageID where P_PageID =" & Page_ID & " order by p_Name"
objRSS.open SQL, objConn
if not objRSS.EOF then
objRSS.MoveFirst
while not objRSS.EOF
'Fill Array
testArray(0, increment) = objRS("P_PageID")
objRSS.MoveNext
wend
objRSS.close
objConn.close
else
testArray(0, increment) = "-"
end if
Increment = Increment + 1
'--------------------------------------------
%>
<%
objRS.MoveNext
wend
objRS.Close
objCon.Close
response.Write testArray(0,5)
Figured it out myself by using preseve in the redim of my array so the code below fixed my problem -
'--------------------------------------------
Increment = 0
Dim testArray()
connectionstring = obj_ADO.getconnectionstring
Set objConn = CreateObject("ADODB.Connection")
Set objRSS = CreateObject("ADODB.Recordset")
objConn.Open connectionstring
SQL = "select * from a_permission inner join L_PagePermission on P_PermissionID = PP_PermissionID inner join A_Page on P_PageID = PP_PageID order by P_Name"
objRSS.open SQL, objConn
if not objRSS.EOF then
objRSS.MoveFirst
while not objRSS.EOF
Redim Preserve testArray(2, increment)
'Two Dimensional Array
testArray(0, increment) = objRSS("P_PageID")
testArray(1, increment) = objRSS("P_Name")
objRSS.MoveNext
Increment = Increment + 1
wend
objRSS.close
objConn.close
else
testArray(0, increment) = "-"
testArray(1, increment) = "-"
end if
'--------------------------------------------
'--------------------------------------------
Page_ID = objRS("P_PageID")
for i = 0 to (increment - 1)
if testArray(0, i) = Page_ID then
%>
<li style="" ="padding:0;margin:0;"><%=testArray(1,i)%></li>
<%
end if
next
'--------------------------------------------
If you run this query, do you get rows returned?
Select P_Name as P_Name, P_Description as P_Description from L_PagePermission inner join A_Permission on p_permissionID = pp_PermissionID inner join A_Page on P_PageID = PP_PageID where P_PageID =" & Page_ID & " order by p_Name
I've asked a similar question before and although I've attempted to fix my previous code i now end up with an error "Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another". I want to pass a single character as a parameter to query a database then use recordset to print out to a webpage. My classic asp code is below
Set objCon = CreateObject("ADODB.Connection")
Set objRS = CreateObject("ADODB.Recordset")
set objComm = CreateObject("ADODB.Command")
objCon.ConnectionString = "Provider=SQLOLEDB.1;Password=xxxx;Persist Security Info=True;User ID=xxxx;Initial Catalog=Movies;Data Source=xxxx-PC"
objCon.open objCon.ConnectionString
objComm.ActiveConnection = objCon.ConnectionString
objComm.CommandText = "Paging_Movies"
objComm.CommandType = adCmdStoredProc
Set objParameter = objComm.CreateParameter
objParameter.Name = "alphaChar"
objParameter.Type = adChar
objParameter.Direction = adParamInput
objParameter.Value = "a"
objComm.Parameters.Append objParameter
set objRs = objComm.Execute
Also my stored procedure is below -
CREATE PROCEDURE Paging_Movies
#alphaChar char(1)
AS
if #alphaChar = '#'
select * from Movies where movies like '[^a-z]%'
else
select * from Movies where movies like #alphaChar + '%'
Perhaps you're adding the parameter twice. Try to replace:
objComm.ActiveConnection = objCon.ConnectionString
objComm.CommandText = "Paging_Movies"
objComm.CommandType = adCmdStoredProc
Set objParameter = objComm.CreateParameter
objParameter.Name = "alphaChar"
objParameter.Type = adChar
objParameter.Direction = adParamInput
objParameter.Value = "a"
Set objParameter = objCommand.CreateParameter ("alphaChar", adChar, _
adParamInput, "a")
objComm.Parameters.Append objParameter
with just:
objCommand.CreateParameter ("alphaChar", 129, 1, 1, "a")
Edited as your comment suggests to use the numeric values for adChar (129) and adParamInput (1) from the W3Schools CreateParameter page.