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
Related
I am trying to import a CSV file split by semicolon ";" into an excel object so I can use it later on.
Ideally i would like to use ADO, DAO or ADODB so I can also run SQL queries on the object, and get sum of specific fields, or total number of fields and so on.
So far i've gotten the code below, but it does not split the data by ";", so it all comes back as 1 field instead of multiple fields that can be handled.
Sub Import()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim f As ADODB.Field
Dim csvName, csvPath
csvPath = ActiveWorkbook.path
csvName = "fileName.csv"
conn.Open "DRIVER={Microsoft Text Driver (*.txt; *.csv)};DBQ=" & csvPath & ";"
rs.Open "SELECT * FROM " & csvName, conn, adOpenStatic, adLockReadOnly, adCmdText
Debug.Print rs.Fields
While Not rs.EOF
For Each f In rs.Fields
Debug.Print f.Name & "=" & f.Value
Next
Wend
End Sub
Can anyone give me an idea how I can also split the data by ";" and query it using SQL query? Or a different object that I could load a CSV into and query certain columns.
Here's example:
Public Sub QueryTextFile()
Dim rsData As ADODB.Recordset
Dim sConnect As String
Dim sSQL As String
' Create the connection string.
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Files\;" & _
"Extended Properties=Text;"
' Create the SQL statement.
sSQL = "SELECT * FROM Sales.csv;"
Set rsData = New ADODB.Recordset
rsData.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
' Check to make sure we received data.
If Not rsData.EOF Then
' Dump the returned data onto Sheet1.
Sheet1.Range("A1").CopyFromRecordset rsData
Else
MsgBox "No records returned.", vbCritical
End If
' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
End Sub
The only answer I found that was usable was to create an ini file in the current folder, and enter the delimiter in the ini file.
iniPath = activeworkbook.path & "\"
iniName = "schema.ini"
iniPathName = iniPath & iniName
If Not fso.FileExists(iniPathName) Then
fso.CreateTextFile (iniPathName)
End if
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
I'm trying to connect Teradata Sql assistant to Excel through VBA. I'd like to write a query in VBA and print the result in a Sheet. I have gone through all the previous explanations but I still can't figure out why it's not working.
Dim strConn As String
strConn = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=TERADATA"
Dim Query As String
Query = "select * FROM P_ZC074_TMIS.FACT_TMX_PL_NII_TP_FX where CNT_ORG ='5872196'"
Dim rs As New ADODB.Recordset
rs.Open Query, strConn
Sheet1.Range("A1").CopyFromRecordset rs
I have activated the Microsoft ActiveX Data Objects 6.1 Library but
I receive a "Query Timeout Expired" error; I guess I have to use a CommandTimeout to fix this issue (assuming that it's just that) but I have no idea how to write that in VBA code.
Thanks in advance.
You need to open a connection to the database first and pass that to the recordset that you're trying to open similar to this:
Public Sub GetData()
Dim oDB As ADODB.Connection: Set oDB = New ADODB.Connection
Dim oCM As ADODB.Command: Set oCM = New ADODB.Command
Dim oRS As ADODB.Recordset: Set oRS = New ADODB.Recordset
Dim strConn As String, strQuery As String
On Error GoTo Err:
strConn = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=TERADATA"
strQuery = "select * FROM P_ZC074_TMIS.FACT_TMX_PL_NII_TP_FX where CNT_ORG ='5872196'"
oDB.Open strConn
With oCM
.ActiveConnection = oDB
.CommandType = adCmdText
Set oRS = .Execute
End With
If Not oRS.BOF And Not oRS.EOF Then
ThisWorkbook.Worksheets("Sheet1").Range("A1").CopyFromRecordset oRS
End If
Err:
On Error Resume Next
oRS.Close
Set oRS = Nothing
oDB.Close
Set oDB = Nothing
MsgBox ("An error occurred!" & vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Message: " & Err.Description), vbCritical, "Error!"
End Sub
I have built a macro, wherein data is first imported into 'Raw' worksheet. Before importing, 'Raw' sheet is first cleared of previous data.
Then i query it using SQL in VBA and get the final output in desired format.
Lately i have been facing an issue, which gives a error message "The Connection for viewing your linked Microsoft Excel Worksheet was lost".
The same macro works fine if i dont clear the 'Raw' sheet before importing data.
Any help is appreciated.
Option Explicit
Public ROW As Integer
Public Cnn As New ADODB.Connection
Public Rs As New ADODB.Recordset
Public StrSQL As String
Public Sub OpenDB()
If Cnn.State = adStateOpen Then Cnn.Close
Cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
ActiveWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name
Cnn.Open
End Sub
Public Sub CloseRS()
If Rs.State = adStateOpen Then Rs.Close
Rs.CursorLocation = adUseClient
End Sub
Sub MonthlyYorN()
StrSQL1 = "SELECT * FROM [RAW$] where SOME CONDITION"
StrSQL1 = "SELECT * FROM [RAW$] where SOME CONDITION2"
StrSQL = StrSQL1 & " UNION " & StrSQL2
CloseRS
OpenDB
Rs.Open StrSQL, Cnn, adOpenKeyset, adLockOptimistic
If Rs.RecordCount > 0 Then
'Do Something
End If
End Sub
This is not a VBA issue, it's a problem with the ODBC Driver. Go to →ODBC to open Data Sources, then into the Advanced Settings for the Excel ODBC Driver, and make sure to turn on checkbox:
☑ Enable Automatic Reconnect
MS Access ODBC can experience the same problem, fixed the same way.
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