VBA Error - Type MisMatch - sql

I don't know why Excel - VB is behaving stupidly. My tool has several user forms. Everything was working fine until I renamed a command button's caption. I am getting a Type miss-match error. The command loads another form. The form_initialise code is below. when I commented out all of the code the code in userform_initialise it works fine, but when remove the comment ' from all the lines it give me an error Type Mismatch.
Earlier it was working perfect and my company is using it as well. Can anyone help.
Private Sub UserForm_initialize()
lstUser.AddItem Sheets("LAUNCH").Range("Z1").Value
Application.ScreenUpdating = False
Dim conn As Object
Dim rs As Object
Dim objMycmd As Object
Dim rc As Long
Dim sConnString As String
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=XXXXXXXX;" & _
"Initial Catalog=XXXXXX;" & _
"Integrated Security=XXXXXXXX;" & _
"User ID=XXXXXXXXXXXXXXXX;" & _
"Passsword=XXXXXXXXXXXXXXXXX;"
' Create the Connection and Recordset objects.
Set conn = CreateObject("ADODB.Connection")
' Open the connection and execute.
conn.Open sConnString
Sql = "Select DISTINCT [Exec] from tblKPI3"
Set rs = CreateObject("ADODB.Recordset")
rs.Open Sql, conn, adOpenStatic
If rs.EOF Then
MsgBox "No Records"
Else
rs.Movefirst
If Sheets("LAUNCH").Range("AA1") = "Yes" Then
With frmReport.lstUser
.Clear
Do
.AddItem rs![exec]
rs.MoveNext
Loop Until rs.EOF
End With
End If
End If
rs.Close
conn.Close
end sub

Related

Using VBA to query a VIEW from SQL Server

I am trying to create a VBA script that will pull the results from a View (SELECT * FROM view_name) from the RecordSet.Source property, but when attempted, my CloseConnection error handler keeps getting caught. I can get results from a table using a simple query like SELECT * FROM tbl_name with no issues.
Below is the code I am using. Note: my Const variable has the Provider and Database information removed.
I guess it really comes down to is it even possible to get results from a View like I would from a table?
Option Explicit
Const ConStrMSSQL As String = _
"Provider=provider_name;Database=database_name;Trusted_Connection=yes;"
Sub test()
Dim formConnect As ADODB.connection
Dim formData As ADODB.recordSet
Dim formField As ADODB.Field
Set formConnect = New ADODB.connection
Set formData = New ADODB.recordSet
formConnect.ConnectionString = ConStrMSSQL
formConnect.Open
On Error GoTo CloseConnection
With formData
.ActiveConnection = formConnect
.Source = "SELECT * FROM v_data_extract_658"
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
On Error GoTo CloseRecordset
Sheets("test").Range("A1").Select
For Each formField In formData.Fields
ActiveCell.Value = formField.Name
ActiveCell.Offset(0, 1).Select
Next formField
Sheets("test").Range("A2").CopyFromRecordset formData
On Error GoTo 0
CloseRecordset:
formData.Close
CloseConnection:
formConnect.Close
End Sub
This is the error message:
run-time error 2147467259 (80004005): unknown token received from SQL Server
I think the big issue here is that you haven't defined a Command Object.
I somewhat put this together "freehand" and for certain, didn't test it but it should get you to where you need to go.
Sub test()
On Error GoTo ErrorHandle:
Dim formConnect As ADODB.Connection
Set formConnect = New ADODB.Connection
formConnect.ConnectionString = ConStrMSSQL
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
formConnect.Open
With cmd
.ActiveConnection = formConnect
.CommandType = adCmdText
.CommandText = "SELECT * FROM v_data_extract_658"
.CommandTimeout = 30
End With
Dim formData As ADODB.Recordset
Set formData = New ADODB.Recordset
formData.Open cmd, , adOpenStatic, adLockReadOnly
Sheets("test").Range("A1").Select
Dim formField As ADODB.Field
For Each formField In formData.Fields
ActiveCell.value = formField.Name
ActiveCell.Offset(0, 1).Select
Next formField
Range("A2").CopyFromRecordset formData
On Error GoTo 0
Cleanup:
If Not formData Is Nothing Then
If formData.State <> adStateClosed Then formData.Close
Set formData = Nothing
End If
If Not formConnect Is Nothing Then
If formConnect.State <> adStateClosed Then formConnect.Close
Set formConnect = Nothing
End If
Set cmd = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description
'Do whatever else is needed to respond to errors.
Resume Cleanup
End Sub
Using Excel & VBA to fetch dta from SLQ Server is quite easy (not always, but these days).
Sub ADOExcelSQLServer()
' Carl SQL Server Connection
'
' FOR THIS CODE TO WORK
' In VBE you need to go Tools References and check Microsoft Active X Data Objects 2.x library
'
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Server_Name = "EXCEL-PC\SQLEXPRESS" ' Enter your server name here
Database_Name = "NORTHWND" ' Enter your database name here
User_ID = "" ' enter your user ID here
Password = "" ' Enter your password here
SQLStr = "SELECT * FROM [Customers]" ' Enter your SQL here
Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
rs.Open SQLStr, Cn, adOpenStatic
' Dump to spreadsheet
For iCols = 0 To rs.Fields.Count - 1
Worksheets("Sheet1").Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
With Worksheets("sheet1").Range("a2:z500") ' Enter your sheet name and range here
'.ClearContents
.CopyFromRecordset rs
End With
' Tidy up
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
As an aside, you can try this as well (please change to suit your specific setup/configuration)...
Sub Working2()
Dim con As Connection
Dim rst As Recordset
Dim strConn As String
Set con = New Connection
strConn = "EXCEL-PC\SQLEXPRESS;Database=Northwind;Trusted_Connection=True"
con.Open strConn
'Put a country name in Cell E1
Set rst = con.Execute("Exec dbo.MyOrders '" & ActiveSheet.Range("E1").Text & "'" & ActiveSheet.Range("E2").Text & "'")
'The total count of records is returned to Cell A5
ActiveSheet.Range("A5").CopyFromRecordset rst
rst.Close
con.Close
End Sub
Please see the link below for more details.
https://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm#Excel%20Data%20Export%20to%20SQL%20Server%20Test%20Code

Using ADODB to print recordset to an Excel sheet

I'm trying to use an ADODB connection to create a record set from a query, then copy the contents of that record set into a range of cells
Below is the outline of my code, but I keep getting errors
Run-time error '-2147467259 (80004005)' Unspecified error
(I've replaced my specific references with all caps dummy references)
Sub Subroutine()
'establish ADODB connection to retrieve data from TABLE
Dim objConnection As New ADODB.connection
Dim objRecordset As New ADODB.Recordset
With objConnection
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source = MYDATASOURCE" & _
"Extended Properties = Excel 8.0;HDR = Yes;"
.Open
End With
'use query to record data to Excel range
Set objRecordset = objConnection.OpenRecordset("Select * From TABLE Where FieldNm = NAME")
With objRecordset
.Open
.MoveFirst
Do Until .EOF
Worksheets("WORKSHEET").Cells(14, 1) = objRecordset.Fields.Item("FieldNm")
.MoveNext
Loop
End With
End Sub
The debug goes to the .Open in my With objConnection block. Before that I was having problems with the .MoveNext method.
Assuming your SQL is correctly specifying worksheet range, consider adjusting some items in and outside of With...End With block.
OpenRecordset is a DAO method. Use Recordset.Open for ADO
Remove the second .Open call
Remove the recordset name inside With
Loop through worksheet down the rows instead of reassign same cell
Use error handling for more informative error message to capture runtime exceptions
VBA
Sub Subroutine()
On Error Goto ErrHandle
'...same as above...
objRecordset.Open "Select * From TABLE Where FieldNm = NAME", objConnection
With objRecordset
.MoveLast
.MoveFirst
i = 0
Do Until .EOF
Worksheets("WORKSHEET").Cells(14 + i, 1) = .Fields("FieldNm")
i = i + 1
.MoveNext
Loop
.Close
End With
objConnection.Close
ExitHandle:
Set objRecordset = Nothing
Set objConnection = Nothing
Exit Sub
ErrHandle:
Msgbox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Resume ExitHandle
End Sub

Connecting to password protected DB VBA

Hi im pretty new to VBA and im trying to build a connection with a database protected by a password. This is my code.
Sub CostEntry()
ActiveWorkbook.Sheets.Add.Name = "SAP Sheet"
sConnString = "SourceType:=0, Source:=ODBC;DSN=SAPDATA32;Description=DATA;UID=shareuser;Jet OLEDB:Database Password=1234;APP=Microsoft Office 2016;WSID=AT;DATABASE=DATA"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute.
conn.Open sConnString
Set rs = conn.Execute("SELECT MBEW.BWKEY, MBEW.STPRS, MBEW.MATNR" & Chr(13) & "" & Chr(10) & "FROM SAPDATA.dbo.MBEW MBEW" & Chr(13) & "" & Chr(10) & "WHERE (MBEW.BWKEY='1010')")
' Check we have data.
If Not rs.EOF Then
' Transfer result.
ActiveWorkbook.Sheets("SAP Sheet").range("A1").CopyFromRecordset rs
' Close the recordset
rs.Close
Else
MsgBox "Error: No records returned.", vbCritical
End If
' Clean up
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub
Most of it i also copied from the internet adn i also think it was from stackoverflow. I alwas get the error message "Run-time error '-2147467259 (8000400)': Could not find installable ISAM". I trie inserting the line Provider=Microsoft.ACE.OLEDB.12.0
but it just gave me another error message.
Thnak you all in advance.
Try providing single quotes for the property value
Provider='Microsoft.ACE.OLEDB.12.0'
Found out i just needed to add a PW:1234 field

Excel ADODB connection for SQL runtime error

I was trying to use SQL queries to work with my excel sheets as tables. I wrote the following code:
Global objConn As ADODB.Connection
Global ConnString As String
Global SQL As String
Global objRS As ADODB.Recordset
Global masterFile As String
Public Sub XL_DB_connect()
Set objConn = New ADODB.Connection
masterFile = ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name
ConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & masterFile & ";" & _
"Extended Properties=""Excel 12.0;" & _
"HDR=Yes;"";"
objConn.ConnectionString = ConnString
objConn.Open
End Sub
Public Sub executeQuery()
objRS.Source = SQL
objRS.ActiveConnection = objConn
objRS.Open
End Sub
Public Sub XL_DB_relMem()
Set objRS = Nothing
Set objConn = Nothing
SQL = vbNullString
End Sub
Public Sub test()
Set objRS = New ADODB.Recordset
objRS.CursorLocation = adUseClient
SQL = "select PatientGID, count(LOT) from [Sheet1$] group by PatientGID"
Debug.Print SQL
Call XL_DB_connect
Call executeQuery
objRS.MoveFirst
Range("Output").Resize(10, 2).ClearContents
Range("Output").CopyFromRecordset objRS
End Sub
Sheet1 has the following columns starting from cell A1
patientGID
progression
loT
newLoT
loTFdate
actualRegimen
loTRegimenClass
progressionClass
pERMetFlag
On running the code, I get following error:
"Run-time error '-2147467259 (80004005)'
'Sheet1$' is not a valid name. Make sure that it does not include
invalid characters and punctuation and that it is not too long"
I got the same error today. I found that the reason was the excel file was in its read-only status. When I saved it in another location, the error was immediately fixed.

Issues connecting to MSSQL through VBA

I'm having some trouble connecting to an MSSQL Server through VBA Below is my code that is having trouble
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
con.Provider = "sqloledb"
sConnectionString = "Server=SQLServer;Database=DBName;UID=sa;Pwd=NiceTry"
con.Open sConnectionString
'Dim sh As Worksheet
Dim tempSheet As String
tempSheet = "IgnoreMe"
'See if there is already an "IgnoreMe" Sheet, create it if not.
Dim wsSheet As Worksheet
On Error Resume Next
Set wsSheet = Sheets("IgnoreMe")
On Error GoTo 0
If Not wsSheet Is Nothing Then
'Sheet exists, don't recreate it.
Else
Sheets.Add.Name = tempSheet
End If
Set sh = Worksheets("IgnoreMe")
' Clean up the sheet's contents
sh.UsedRange.Clear
' Now get the table's data
rs.Open "SELECT JobHeaderID, Job, ProofApproved, SleeveLabel, MasterLabel" & _
" FROM JobHeader " & _
" WHERE Job IN ('665511', '671259', '671259-1')", con
End Sub
This is just the part to download the information. I have other code to read through the recordset. On the rs.Open line I always get an Automation Error I can't figure out what problem it's hitting. Any ideas on what it's hitting?
I'm trying to follow http://webcheatsheet.com/ASP/database_connection_to_MSSQL.php the piece without DSN
Found a very straightforward example here
Here is my working code sanitized
Sub IterateColE()
' Clean up the destination sheet's contents
Sheets("IgnoreMe").UsedRange.Clear
'We're going to iterate through column E until we hit a blank/empty cell.
For Each currCell In Worksheets("Main").Range("E:E").Cells()
'Oh! and we dont want to get the header row
If currCell.Row 1 Then
If (currCell.Text "") And (currCell.Text vbNullString) Then
'Get values for job in currCell and place in the matching row on IgnoreMe
getValues currCell.Value, currCell.Row
Else
'Well, seems we've hit a blank cell, stop processing
Exit For
End If
End If
Next
End Sub
'Gets the needed values for the job and places them in "IgnoreMe" sheet on specified row. They can then be referenced like "=IgnoreMe!C3"
Sub getValues(job As String, destinationRow As Integer)
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=SQLServer;" & _
"Initial Catalog=InitialTableName;" & _
"UID=DBUsername;Pwd=Nicetry;"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute.
conn.Open sConnString
Set rs = conn.Execute("SELECT JobHeaderID, Job, DataProofApproved, SleevePackLabel, MasterLabel" & _
" FROM JobHeader " & _
" WHERE Job='" & job & "'")
' Check we have data.
If Not rs.EOF Then
' Transfer result.
Sheets("IgnoreMe").Range("A" & destinationRow).CopyFromRecordset rs
' Close the recordset
rs.Close
Else
MsgBox "Error: No records returned.", vbCritical
End If
' Clean up
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub
'Close out your connection when you close the workbook. Locked database tables are annoying
Private Sub Workbook_Deactivate()
If Not (con Is Nothing) Then
con.Close
Set con = Nothing
End If
End Sub