I am trying to run SQL query on sql server (some DWH) and then insert outcome into access table (using VBA).
I did it by using ADODB.Connection, ADODB.Command and ADODB.Recordset. At this point I have my outcome in Recordset and I Wonder how I can insert it into table without looping it.
I tried:
If Not (Rs.EOF And Rs.BOF) Then
Rs.MoveFirst
Do Until Rs.EOF = True
DoCmd.RunSQL ("INSERT INTO Table (F1, F2) VALUES ( " & rs![F1] & ", " & rs[F2] & ")"
Rs.MoveNext
Loop
End If
But Recordset may have over 100k rows. So it would take ages to insert it by using this method.
Another very fast way is to open a new excel workbook paste it into worksheet and then import it. But I would like to avoid it. Is there any other way ?
---------EDITED-----------
Sorry guys. My bad. I was forcing solution with VBA while linkin it was perfect. THANKS !
I was wondering if there is any as fast way which use Access
resources only.
As already mentioned, link the SQL table, then create a simple append query that reads from the linked table and writes to your Access table, and you're done.
I agree with the commenters that you should link if at all possible. But I wanted to see if it could be done. I ended up converting the recordset to a comma delimited file and use TransferText to append it.
Public Sub ImportFromSQLSvr()
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim sResult As String
Dim sFile As String, lFile As Long
Const sIMPORTFILE As String = "TestImport.txt"
Set cn = New ADODB.Connection
cn.Open msCONN
Set rs = cn.Execute("SELECT SiteID, StoreNumber FROM Site")
'Add a header row, replace tabs with commas
sResult = rs.GetString
sResult = "SiteID, StoreNumber" & vbNewLine & sResult
sResult = Replace(sResult, vbTab, ",")
'Write to a text file
lFile = FreeFile
sFile = Environ("TEMP") & "\" & sIMPORTFILE
Open sFile For Output As lFile
Print #lFile, sResult
Close lFile
'Append to table dbo_Site
DoCmd.TransferText acImportDelim, , "dbo_Site", Environ("TEMP") & "\" & sIMPORTFILE, True
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
If you have any commas in your data, you'll need to do some extra work to properly format the csv.
Related
I'm start to do programming in Access, and I really need help!!
My objective is to create a module that is run in "tbCustoProjeto" table and rewrite the field "Valor HH" values based on Dlookup. I found some solution (by azurous) who I think will solve this, but when I run the code, is returned
"object-required-error".
Sub redefineHH()
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
Dim i As Integer
Dim value As Variant
Dim HHTotal As Double
Set HHTotal = DLookup("[CustoTotalNivel]", "tbNivelNome2", "nUsuario='" & tbCustoProjeto!NumUsuario & "'" & "AND Numeric<=" & tbCustoProjeto!DataNumero)
'initated recordset obejct
objRecordset.ActiveConnection = CurrentProject.Connection
Call objRecordset.Open("tbCustoProjeto", , , adLockBatchOptimistic)
'find the target record
While objRecordset.EOF = False
'If objRecordset.Fields.Item(13).value > 0 Then
objRecordset.Fields.Item(13).value = HHTotal
objRecordset.UpdateBatch
'exit loop
'objRecordset.MoveLast
objRecordset.MoveNext
'End If
Wend
MsgBox ("Pesquisa Finalizada")
End Sub
Print of tbCustoProjeto
Print of tbNivelNome2
Please, someone can tell me where is the error? I don't know what to do.
Cannot reference a table directly like that for dynamic parameter. DLookup should pull dynamic criteria from recordset and within loop. Don't use apostrophe delimiters for number type field parameter.
Remove unnecessary concatenation.
Sub redefineHH()
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
objRecordset.Open "tbCustoProjeto", CurrentProject.Connection, , adLockBatchOptimistic
While objRecordset.EOF = False
objRecordset.Fields.Item(13) = DLookup("[CustoTotalNivel]", "tbNivelNome2", _
"nUsuario=" & objRecordset!NumUsuario & " AND Numeric <=" & objRecordset!DataNumero)
objRecordset.UpdateBatch
objRecordset.MoveNext
Wend
MsgBox ("Pesquisa Finalizada")
End Sub
I have some problem when I deal with MS Access. I am using SQL Server and MS Access together.
I try to insert data into a new table.
First, this program asks me to add an item to the list (it is like temporary table). And then, there is another submit button which confirms the data (this step is needed and it is not inefficient one. Please do not ask about this step).
To add data to the list, I use a stored procedure. But I do not know what do I need to do to submit the data again.
Here is my code:
Dim rs As ADODB.Recordset
strConn = "DRIVER=SQL Server;SERVER=CHU-AS-0004;DATABASE=RTC_LaplaceD_DEV;Trusted_Connection=Yes;"
Set conn = New ADODB.Connection
conn.Open strConn
cmd.ActiveConnection = conn
Set rs = New ADODB.Recordset
rs.Open "Insert into dbo.Blend values(List731.Column(1, introw),List731.Column(2, introw),TextRequestNo.Value, List731.Column(3, introw),List731.Column(4, introw),List731.Column(5, introw))"
conn.Close
Set rs = Nothing
MsgBox "Done"
When I run with this code, I get this error:
I think there is some missing in my code but I do not know how to proceed.
Is there anyone who can give me some information about this?
There are many ways to do this kind of thing. Something like this should get the job done.
Sub MoveDateFromAccessToSQLServer()
Dim adoCN As ADODB.Connection
Dim sConnString As String
Dim sSQL As String
Dim lRow As Long, lCol As Long
sConnString = "Provider=sqloledb;Server=servername;Database=NORTHWIND;User Id=xx;Password=password"
Set adoCN = CreateObject("ADODB.Connection")
'adoCN.Open sConnString
'Assumes that you have Field1, Field2 and Field3 in columns A, B and C
'Text values must be enclosed in apostrophes whereas numeric values should not.
sSQL = "INSERT INTO YOUR_TABLE (FIELD1, FIELD2, FIELD3) " & _
" VALUES (" & _
"'" & Column(1, introw) & "', " & _
"'" & Column(2, introw) & "', " & _
"'" & Column(3, introw) & "')"
adoCN.Execute sSQL
adoCN.Close
Set adoCN = Nothing
End Sub
i have an ADODB recordset to load data from a view in an Excel sheet. The view is located in a MS SQL database. It runs perfectly for months, but since a few days the recordset is always empty, so i did not get any results. After a long day searching the www for any reasons i found, that it can happen because i use a x32 Excel and there is so much data in the view. So i separated the procedure in two queries. This helped a lot and the macro run perfectly again. Yesterday the same error appears again, so i began to split the procedure again. But now the recordset is still empty. I don't know any reason for this. I tested it with a selection of only ten rows of the view and this runs but if i want to get 1000 rows the recordset is empty again. Does anybody know a reason for this problem? All queries give the result i want to have in the database so they are ok.
Here is my code:
Sub doStuff()
Dim sqlStatement(9) As String
Dim lrow As Long
'... other variables
sqlStatement(1) = "Select * from db.View1 where location like 'forest'"
'... other sqlStatements
For i = 0 To UBound(sqlStatement)
Call loadData(sqlStatement, lrow)
Next i
End Sub
Sub loadData(sqlStatement As String, lastrow As Long)
Dim sqlServer As String
Dim dbName As String
sqlServer = "MSSQLSERVER"
dbName = "database"
On Error Resume Next
Dim con As Object
Set con = CreateObject("ADODB.Connection")
con.Open _
"Provider = sqloledb;" & _
"Data Source=" & sqlServer & ";" & _
"Initial Catalog=" & dbName & ";" & _
"User ID=user1;" & _
"Password=abcde;"
Dim rst As Object
Set rst = CreateObject("ADODB.Recordset")
With rst
.ActiveConnection = con
.Open sqlStatement , con, adLockReadOnly
ws.Activate
If lastrow = 1 Then
For col = 0 To .Fields.Count - 1
ws.Cells(1, col + 1).Value = .Fields(col).Name
Next
End If
ws.Activate
ws.Cells(lastrow+1,1).CopyFromRecordset rst
.Close
End With
con.Close
Set rst = Nothing
Set con = Nothing
End Sub
For those who don't know, it is fairly easy to add SQL functionality to VBA macros. The following article provides the code: http://analystcave.com/excel-using-sql-in-vba-on-excel-data/
I modified this a bit (happy to provide the code) so that it outputs nicely and put it in a Sub that I can call. This saves me from having to do multiple sorts, copy paste, etc. to find specific data from a large worksheet.
Note a problem, however, when working with the workbook from an online source e.g. Gmail:
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";"
This works fine when the file is saved to a drive, but from an online site, Excel can't connect. Any suggestions on modifying the connection string for when the file isn't saved anywhere?
For anyone who's interested, this code (based on the code from Analyst Cave) works great for using SQL in VBA. Save the following as a Sub:
Option Explicit
Sub QuerySQL(result_location As Range, query As String)
Dim ResultWS As Worksheet
Set ResultWS = ThisWorkbook.Sheets("Query Results")
ResultWS.Cells.ClearContents
If query = "" Then Exit Sub
Dim cn As Object, rs As Object
'Add to the workbook a database connection with itself
'Note other ConnectionString could be used to access a variety of media
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
.Open
End With
'Build and execute the SQL query
Set rs = cn.Execute(query)
If rs.EOF = True Then Exit Sub
'Print column labels
Dim i As Long, j As Long
For i = 0 To rs.Fields.Count - 1
result_location.Offset(0, i).Value = rs.Fields(i).Name
Next i
'Print column contents
i = 0
Do
For j = 0 To rs.Fields.Count - 1
result_location.Offset(i + 1, j).Value = rs.Fields(j).Value
Next j
rs.MoveNext
i = i + 1
Loop Until rs.EOF
'Close the connections
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
To use it, simply do the following:
Dim myQuery As String
myQuery = "SELECT * FROM [Sheet2$]"
Call QuerySQL(ThisWorkbook.Sheets("Sheet1").Range("A1"), myQuery)
It uses MS Access style SQL. The above will look to Sheet2 as the table and print the result starting in A1 on Sheet1.
I have some simple code that will load all the data from an excel sheet into an array but I am getting an error 94 inproper use of null due to the fact that my source sheet has some blank columns IE: Q through EA are blank columns but A -P and EB - EF have data. (terrible design for an excel sheet being used as a table I know,.. but I didn't do it)
Seeing as I cant redesign the table.. how can I skip the blanks as to avoid causing errors when loading them into my array?
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim DBPath As String, sconnect As String
DBPath = "\\MYPATH\MYFILE.xlsm"
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Conn.Open sconnect
sSQLSting = "SELECT * From [log$]"
mrs.Open sSQLSting, Conn
'=>Load the Data into an array
ReturnArray = mrs.GetRows
'Close Recordset
mrs.Close
'Close Connection
Conn.Close
The IsNull() function returns True or False. So include it inside Jet/ACE's conditional logic function IIF()
sSQLString = "SELECT IIF(IsNull(Col1), 0, Col1)," _
& " IIF(IsNull(Col2), 0, Col2)," _
& " IIF(IsNull(Col3), 0, Col3)"
& " From [log$];"
#JohnsonJason Why do you need it in a Array? You could just filter your data with Advanced Filter like here or just drop it and loop to get the columns you need. If you don't know how many columns will be you can create a clone Recordset and get the columns Name and create your Query based on that.
The clone RecordSet is something like this:
'' Declare Variables
Dim oRst As ADODB.Recordset, oRstVal As ADODB.Recordset, oStrm As ADODB.Stream
Dim sHeaders as String
'' Set Variables
Set oRst = New ADODB.Recordset
Set oRstVal = New ADODB.Recordset
Set oStrm = New ADODB.Stream
.... [Something else]
'' Save your current Recordset in the Stream
oRst.Save oStrm
'' Assign your Stream to the new Recordset (oRstVal)
oRstVal.Open oStrm
'' Loop trough your Recorset for Columns Name
'' Use an IF or a Select to filter
For iCol = 0 To oRstVal.Fields.Count - 1
sHeaders = sHeaders + "," + oRstVal.Fields(iCol).Name
Next
And use sHeaders in your Statement in to get the columns you need.
''Instead of Select * From ...
sQuery = "Select " + sHeaders + _
"From ...."