Executing a macro from VBScript gives error :
Method CopyFromRecordset of object 'Range' failed
But It works fine, when I execute same from Excel workbook.
I tried executing from Excel workbook and it worked fine.
Here Is My VBA Code:
Set conn = New ADODB.Connection
conn.connectionString = "PROVIDER=SQLOLEDB;DATA SOURCE=localhost\SQLEXPRESS;INITIAL CATALOG=DEVDB; INTEGRATED SECURITY=sspi;"
Set rs = New ADODB.Recordset
str = "exec SP_Getcustomers #RequestID=" & requestID
rs.Open str, conn, adOpenStatic, adLockReadOnly
If Not IsEmptyRecordset(rs) Then
rs.MoveFirst
'Populate the first row of the sheet with recordset’s field names
i = 0
For Each fld In rs.Fields
ActiveWorkbook.Worksheets("Customer Table").Cells(1, i + 1).Value = rs.Fields.Item(i).Name
i = i + 1
Next fld
'Populate the sheet with the data from the recordset
ActiveWorkbook.Worksheets("Customer Table").Range("A2").CopyFromRecordset rs
End If
VB Script Code:
Dim path, macroname
path = ""
path = Wscript.Arguments.Item(2)
macroname = ""
macroname = Wscript.Arguments.Item(3)
Set objExcel = CreateObject("Excel.Application")
objExcel.Application.Run "'" & path & "'!" & macroname, WScript.Arguments.Item(0)
objExcel.Visible = False
objExcel.DisplayAlerts = False
objExcel.Application.Quit
Set objExcel = Nothing
Related
Dim ConnDB As ADODB.Connection
Dim RecSet As ADODB.Recordset
Dim ConnStr As String
Dim SQL_Query As String
Dim iCols As Integer
Const ClaimSheet = "Sheet1"
Set ConnDB = New ADODB.Connection
Set RecSet = New ADODB.Recordset
Const SQLServer = "*****"
Const SQLDB = "*****"
ConnStr = "Provider=SQLOLEDB.1;Data Source=" & SQLServer & ";" & _
"Initial Catalog=" & SQLDB & ";" & _
"Integrated Security=SSPI;"
ConnDB.ConnectionTimeout = 3
ConnDB.Open ConnStr
ConnDB.CommandTimeout = 30
SQL_Query = "EXEC [dbo].[Pivot_Claims]"
Set RecSet = ConnDB.Execute(SQL_Query)
If Not RecSet.EOF Then
ThisWorkbook.Sheets(ClaimSheet).Range("B6").CopyFromRecordset RecSet
RecSet.Close
Else
MsgBox "No Records Found"
End If
I'm trying to run the above VBA code to execute a stored procedure (Pivot_Claims) and paste the results into ClaimSheet. I am getting the error 'Operation is not allowed when the object is closed.' which pointes to the ' If Not RecSet.EOF Then' line.
You need to turn the count off on the stored proc.
SET NOCOUNT ON
I have a excel workbook that pulls data into a table users can then fill in the missing dates in column 11. Column 1 is the unique identifier that matches the ID column in the SQL table. I want to create a macro that runs when the workbook is closed and will update the SQL table with the filled in dates, but I am struggling with the code. I have have tried two different things but neither seem to work.
Option 1:
Private Sub tableupdate()
Dim con As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Dim i As Long
Dim vDB As Variant
Dim ws As Worksheet
con.connectionstring = "Provider=SQLOLEDB;Password=*********;User ID=clx_write; Initial Catalog=DPEDataMartDBPrd01; Data Source=tcp:dscusnoramcloroxprd01.database.windows.net,1433;"
con.Open
Set cmd.ActiveConnection = con
Set ws = ActiveSheet
vDB = ws.Range("A4").CurrentRegion
For i = 2 To UBound(vDB, 1)
cmd.CommandText = "UPDATE [dbo].[all_load_control] set Driver_arr_dte = ' " & vDB(i, 2) & " ' WHERE mst_ship_num = ' " & vDB(i, 1) & " ' "
cmd.Execute
Next i
con.Close
Set con = Nothing
End Sub
option 2:
Private Sub uplodblanks()
Dim r, c, con, dstring
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim lRow
Dim ssql As String
con = "Provider=SQLOLEDB;Password=********;User ID=clx_write; Initial Catalog=DPEDataMartDBPrd01; Data Source=tcp:dscusnoramcloroxprd01.database.windows.net,1433;"
r = 1
c = 1
Worksheets("WTUpload").Calculate
lRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
cn.Open con
i = 1
For i = 1 To lRow
ssql = "update dbo.cxu_all_load_control set driver_arr_dte = " & CDate(Sheets("WTUpload").Cells(i, 11)) & " where mst_ship_num = " & CDbl(Sheets("WTUpload").Cells(i, 11)) & " ; "
cn.Execute ssql
Next i
cn.Close
End Sub
Any help as to why neither of these are working would be great
Replace the mydbConnect() function with you own method of getting a connection.
Sub tableupdate2()
Const COL_NUM As String = "A"
Const COL_DATE As String = "K"
Const TABLE As String = "dbo.all_load_control"
' define update sql
Const SQL As String = " UPDATE " & TABLE & _
" SET Driver_arr_dte = CAST(? AS DATETIME2) " & _
" WHERE mst_ship_num = ? "
' establish connection and create command object
Dim con As Object, cmd As Object, sSQL As String
Set con = mydbConnect() ' establish connection
Set cmd = CreateObject("ADODB.Command")
With cmd
.ActiveConnection = con
.CommandText = SQL
.CommandType = 1 'adCmdText
.Parameters.Append .CreateParameter("P1", adVarChar, 1, 20) '
.Parameters.Append .CreateParameter("P2", adVarChar, 1, 50) ' adParamInput = 1
End With
' prepare to get data from spreadsheet
Dim wb As Workbook, ws As Worksheet, iLast As Integer, iRow As Integer
Set wb = ThisWorkbook
Set ws = wb.Sheets("WTUpload")
iLast = ws.Range(COL_NUM & Rows.count).End(xlUp).Row
Dim p1 As String, p2 As String, count As Long
' scan sheet and update db
Debug.Print "Updates " & Now
With cmd
For iRow = 1 To iLast
p1 = Format(ws.Range(COL_DATE & iRow).Value, "yyyy-mm-dd hh:mm")
p2 = ws.Range(COL_NUM & iRow).Value
If len(p2) > 0 Then
.Parameters(0).Value = p1
.Parameters(1).Value = p2
Debug.Print "Row ", iRow, "p1=" & p1, "P2=" & p2
.Execute
count = count + 1
End If
Next
End With
' end
MsgBox "Rows processed = " & count, vbInformation, "Updates Complete"
con.Close
Set con = Nothing
End Sub
Edit - added connection and test code
Function mydbConnect() As Object
Dim sConStr As String
sConStr = "Provider=SQLOLEDB;Password=*********;User ID=clx_write;" & _
"Initial Catalog=DPEDataMartDBPrd01;" & _
"Data Source=tcp:dscusnoramcloroxprd01.database.windows.net,1433;"
Set mydbConnect = CreateObject("ADODB.Connection")
mydbConnect.Open sConStr
End Function
Sub test()
Dim con As Object, rs As Object
Set con = mydbConnect()
Set rs = con.Execute("SELECT CURRENT_TIMESTAMP")
MsgBox rs.Fields(0), vbInformation, "Current Date/Time"
End Sub
I am having trouble when getting data from SQL Server. Here is the code.
Private Sub Form_Load()
Dim blsCritical As Boolean
'----------------------------------------------
ListBox.AddItem "Initializing..."
'----------------------------------------------
Me.Repaint
'----------------------------------------------
ListBox.AddItem "Welcome"
'----------------------------------------------
Me.Repaint
'----------------------------------------------
ListBox.AddItem "Examining your access rights..."
Call ConnectSQLServer
'----------------------------------------------
Me.Repaint
ListBox.AddItem strSQL
'----------------------------------------------
ListBox.AddItem "Opening database connection..."
'----------------------------------------------
Me.Repaint
End Sub
Sub ConnectSQLServer()
Dim cmd As ADODB.Command
Dim conn As ADODB.Connection
Dim strConn As String
Dim par As ADODB.Parameter
Set objMyConn = New ADODB.Connection
Set objMyRecordset = New ADODB.Recordset
Dim strSQL As String
objMyConn.ConnectionString = "DRIVER=SQL Server;SERVER=CHU-AS-0004;DATABASE=RTC_LaplaceD_DEV;Trusted_Connection=Yes;"
objMyConn.Open
strSQL = "SELECT [currentVersion], [standardVersion] FROM [dbo].[Version]"
If currentVersion = "" Then
MsgBox ("No currentVersion value")
ElseIf Not IsNull(currentVersion) Then
If currentVersion < standardVersion Then
MsgBox ("Upgrade is needed")
ElseIf currentVersion = standardVersion Then
MsgBox ("PASS")
Else
End If
Else
End If
Set objMyRecordset.ActiveConnection = objMyConn
objMyRecordset.Open strSQL
End Sub
I have data in SQL Server:
but I cannot get data from SQL Server. When I execute it, 'No CurrentVersion value' message pops up. I don't see any mistakes in my code. Could you help me to solve this problem?(It would be great if you can share your fixed code...)
Just whipped this up for you to show you where you went wrong... untested...
strSQL = "SELECT [currentVersion], [standardVersion] FROM [dbo].[Version]"
Set objMyRecordset.ActiveConnection = objMyConn
objMyRecordset.Open strSQL
while objMyRecordset.EOF = false
currentVersion = objMyRecordset!currentVersion
objMyRecordset.MoveNext
wend
If currentVersion = "" Then
MsgBox ("No currentVersion value")
ElseIf Not IsNull(currentVersion) Then
If currentVersion < standardVersion Then
MsgBox ("Upgrade is needed")
ElseIf currentVersion = standardVersion Then
MsgBox ("PASS")
Else
End If
Else
End If
Something like this should do the job.
Sub GetDataFromADO()
'Declare variables'
Set objMyconn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
Dim rc As Long
'Open Connection'
objMyconn.ConnectionString = "Provider=SQLOLEDB;Data Source=SAXAM\SQLEXPRESS;Initial Catalog=AdventureWorks2012; Integrated Security=SSPI;"
objMyconn.Open
'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyconn
objMyCmd.CommandText = "select * from [Person].[BusinessEntity] "
objMyCmd.CommandType = adCmdText
objMyCmd.Execute
'Open Recordset'
Set objMyRecordset.ActiveConnection = objMyconn
objMyRecordset.Open objMyCmd
'Copy Data to Excel'
'ActiveSheet.Range("A1").CopyFromRecordset (objMyRecordset)
Application.ActiveCell.CopyFromRecordset (objMyRecordset)
rc = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Cells(rc + 1, 1).Select
'Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Value
objMyconn.Close
End Sub
Here's one more idea. Let's say you had a bunch of Select statements in a bunch of cells from A1, down to whatever, you can add sheets dynamically, and import some sample data on to each sheet, to get a sense of the data structures of multiple tables.
Assuming the following in A1:A3.
SELECT TOP 1000 * FROM [YOUR_DB].[dbo].[YOUR_TABLE1]
SELECT TOP 1000 * FROM [YOUR_DB].[dbo].[YOUR_TABLE2]
SELECT TOP 1000 * FROM [YOUR_DB].[dbo].[YOUR_TABLE3]
Run the script below.
Sub Download_From_Multiple_Tables()
'Initializes variables
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim ConnectionString As String
Dim StrQuery As String
Dim rCell As Range
Dim rRng As Range
Dim sht As Worksheet
Dim LastRow As Long
Set cnn = New ADODB.Connection
'For a trusted Connection, where your user ID has permissions on the SQL Server:
cnn.Open ConnectionString:="Provider=SQLOLEDB.1;" & _
"Data Source=" & "YOUR_SERVER_NAME" & ";Initial Catalog=" & "YOUR_DB_NAME" & _
";TRUSTED_CONNECTION=YES"
'Opens connection to the database
'Timeout error in seconds for executing the entire query; this will run for 15 minutes before VBA timesout, but your database might timeout before this value
cnn.CommandTimeout = 900
Set sht = ThisWorkbook.Worksheets("Sheet1")
'Ctrl + Shift + End
LRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set rRng = Sheet1.Range("A1:A" & LRow)
i = 2
For Each rCell In rRng.Cells
LPosition = InStrRev(rCell.Value, "[dbo]") + 5
' Name the newly added worksheet, based on the cell value
Name = Mid(rCell.Value, LPosition + 1, 99)
' Remove [] characters, as these are not permitted in tab names
Name = Replace(Name, "[", "")
Name = Replace(Name, "]", "")
SheetName = Left(Name, 31)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetName
Worksheets(SheetName).Activate
StrQuery = rCell.Value
'Performs the actual query
rst.Open StrQuery, cnn
'Dumps all the results from the StrQuery into cell A2 of the first sheet in the active workbook
' Dump field names to the worksheet
For intFieldIndex = 0 To rst.Fields.Count - 1
ActiveSheet.Cells(1, intFieldIndex + 1).Value = rst.Fields(intFieldIndex).Name
Next intFieldIndex
' Dump the records to the worksheet
ActiveSheet.Cells(2, 1).CopyFromRecordset rst
' Sheets(i).Range("A1").CopyFromRecordset rst
i = i + 1
rst.Close
Next rCell
End Sub
I have a SQL table called Audit. There are two fields in this table called UN and CN. My server name is analive and DB is DW_ALL. I am trying to capture in excel the username and computer name that accesses/opens my workbook or sheet then write that audit information to my SQL table.
Sub UpdateTable()
Dim cnn As ADODB.Connection
Dim uSQL As String
Dim strText As String
Dim strDate As Date
strText = ActiveSheet.Range("b4").Value
''strDate = Format(ActiveSheet.Range("c4").Value, "dd/mm/yyyy")''
Set cnn = New Connection
cnnstr = "Provider=SQLOLEDB; " & _
"Data Source=icl-analive; " & _
"Initial Catalog=DW_ALL;" & _
"User ID=ccataldo;" & _
"Trusted_Connection=Yes;"
cnn.Open cnnstr
''uSQL = "INSERT INTO tbl_ExcelUpdate (CellText,CellDate) VALUES ('" & strText & "', " & strDate & ")"''
''uSQL = "INSERT INTO Audit (UN,CN) VALUES (MsgBox Environ("username"), MsgBox Environ("username""''
uSQL = INSERT INTO Audit (UN,CN) VALUES ('MsgBox Environ("username") ', 'MsgBox Environ("username"'))
Debug.Print uSQL
cnn.Execute uSQL
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
Connection strings can be tricky things. I rely heavily on ConnectionStrings.com to refresh my memory.
Trusted_Connection and User ID are mutually exclusive. Use trusted connection when you want to log onto SQL Server using your Windows account. Username and password are for logging in with a SQL account.
Assuming you want to use your Windows login; try this:
Provider=SQLNCLI11;Server=analive;Database=DW_ALL;Trusted_Connection=yes;
Here is a sample script that writes to an AccessDB. The SQL Should be similar as well as the needed vba statements. I hope it helps
Also it uses DAO and not Addob connection type.
Private Sub thisbetheshitmane()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim tb As DAO.TableDef
Dim vAr As String
Dim i As Integer
Dim y As Integer
Dim InCombined As Boolean
Dim InOpen As Boolean
Dim vbSql As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Set db = DBEngine.OpenDatabase("C:\Users\dzcoats\Documents\Microsoft.accdb")
For Each tb In db.TableDefs
If Len(tb.Connect) > 0 Then
tb.RefreshLink
End If
Next tb
Set rst = db.OpenRecordset("SELECT DISTINCT [Table_Name].Defect FROM [Table_Name] WHERE [Table_Name].Defect IS NOT NULL;")
Dim QResult() As Variant
QResult = rst.GetRows(rst.RecordCount)
For a = LBound(QResult, 2) To UBound(QResult, 2)
vAr = QResult(0, a)
Next a
For y = LBound(QResult, 2) To UBound(QResult, 2)
If vAr <> "Defect" And vAr <> vbNullString And vAr <> "" Then
If InCombined = True And InOpen = True Then
vbSql = "UPDATE [Table_Name] SET [Table_Name].Status ='Bad Defect Number' WHERE ((([Table_Name].Defect)='" & vAr & "'));"
db.Execute vbSql
End If
If InCombined = False And InOpen = True Then
vbSql = "UPDATE [Table_Name] SET [Table_Name].Status ='Completed' WHERE ((([Table_Name].Defect)='" & vAr & "'));"
db.Execute vbSql
End If
End If
Next y
rst.Close
Set rs = Nothing
db.Close
Set db = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
I am making a .MDB file which include a ms access database and a form made with vb 6. I am using ms access 2000, and I need to connect to both my local database in the MDB, and a remote MS SQL 2005 database.
In the below code, I can use a msgbox to display the value return from the result set, but when try to output it in a textBox, e.g: txtStatus.Value = txtStatus.Value & rstRecordSet.Fields(1) & vbCrLf, it just hangs. And the method show in the original example from the tutorial got a method of Debug.Print something, but it turns out didn't do anything which I can see. I mean, VB doesn't have a console panel, where will the print statement goes to?
The code with got error:
Function Testing()
On Error GoTo Error_Handling
Dim conConnection As New ADODB.Connection
Dim cmdCommand As New ADODB.Command
Dim rstRecordSet As New ADODB.Recordset
conConnection.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\" & CurrentDb.Name & ";"
conConnection.CursorLocation = adUseClient
With cmdCommand
.ActiveConnection = conConnection
.CommandText = "SELECT * FROM Opt_In_Customer_Record;"
.CommandType = adCmdText
End With
With rstRecordSet
.CursorType = adOpenStatic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open cmdCommand
End With
If rstRecordSet.EOF = False Then
rstRecordSet.MoveFirst
Do
MsgBox "Record " & rstRecordSet.AbsolutePosition & " " & _
rstRecordSet.Fields(0).Name & "=" & rstRecordSet.Fields(0) & " " & _
rstRecordSet.Fields(1).Name & "=" & rstRecordSet.Fields(1)
rstRecordSet.MoveNext
Loop Until rstRecordSet.EOF = True
End If
conConnection.Close
Set conConnection = Nothing
Set cmdCommand = Nothing
Set rstRecordSet = Nothing
Exit Function
Error_Handling:
MsgBox "Error during function Testing!"
Exit Function
End Function
I thought it was a joke at the beginning ;-)
Anyway I assume you're talking about ADO, as in your title.
Here you can find stuff.
This site will help you with the connection strings for different database.
The difference between access and sql server using ADO it is exactly the connection string.
I would suggest you to avoid Remote Data Controls cause make your life simpler at the beginning but then you have to struggle with them cause they don't work properly.
This is an example of connection and fetch of data:
Dim cnn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim strSql As String
cnn.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=m:\testdbSource\testSource.mdb;" & _
"User Id=admin;Password=;"
cnn.Open
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdText
cmd.CommandText = "select * from tblSource"
cmd.Execute
Set cmd = Nothing
cnn.Close
Set cnn = Nothing
This sample works for me:
Function Testing()
On Error GoTo Error_Handling
Dim MyDb As String
Dim conConnection As New ADODB.Connection
Dim cmdCommand As New ADODB.Command
Dim rstRecordSet As New ADODB.Recordset
MyDb = "db1.mdb"
With conConnection
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = App.Path & "\" & MyDb
.Open
End With
With cmdCommand
.ActiveConnection = conConnection
.CommandText = "SELECT * FROM Opt_In_Customer_Record;"
.CommandType = adCmdText
End With
With rstRecordSet
.CursorType = adOpenStatic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open cmdCommand
End With
Do While Not rstRecordSet.EOF
MsgBox "Record " & rstRecordSet.AbsolutePosition & " " & _
rstRecordSet.Fields(0).Name & "=" & rstRecordSet.Fields(0) & " " & _
rstRecordSet.Fields(1).Name & "=" & rstRecordSet.Fields(1)
rstRecordSet.MoveNext
Loop
conConnection.Close
Set conConnection = Nothing
Set cmdCommand = Nothing
Set rstRecordSet = Nothing
Exit Function
Error_Handling:
MsgBox "Error during function Testing!"
MsgBox Err.Description
End Function