Currently I am formulating Location codes, with much of the code data ready to be matched. On one sheet I have a state code, county code, and county name (Area_Name), and on the other I have the state code and the county name. From here I am trying to copy the county codes onto the other document.
If there is an error in the SQL code, then it would probably be in the portion that changes when it is put into excel. This is because I have already put this code in to SQL server and it works just fine.
Sub CountyFIPS()
On Error GoTo ErrorHandling
Dim cn As Object, rs As Object, path As String, file As String, sql As String
path = "T:\Marketing\Data Analytics\"
file = "Territory Ranking Worksheet - Final.xlsx"
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.connectionstring = "Data Source=" & path & file & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;Readonly=false;IMEX=0"";"
.Open
End With
sql = "SELECT b.County_Code_FIPS FROM [Zip Code List for Template$] a INNER JOIN " & _
"(SELECT * FROM [Sheet6$]) b ON a.State_FIPS_Code = b.State_Code_FIPS AND " & _
"a.County = b.Area_Name"
Debug.Print (sql)
Set rs = cn.Execute(sql)
Exit Sub
ErrorHandling:
MsgBox ("Source: " & Err.Source & vbNewLine & "Number: " & Err.Number & vbNewLine & "Description: " & Err.Description & vbNewLine & "Help Context: " & Err.HelpContext)
Done:
End Sub
VBA kept telling me there was a syntax error in the from clause, but now it has transitioned into a "No value given for one or more required parameters" error.
I am getting data from AS400 via Excel add-in and I'm trying to find an automated to do this because I have to do this many times with various source files and it's annoying to constantly to having to log in whenever I use a new source file.
For instance, for the source file "bond.tto" I would do this to download it:
In Excel,
go to "Add-Ins" --> "Transfer Data from iSeries." A "Transfer Request" window pops up and from there I choose "create a new file"... the path and the file name is c:\bond.tto.
"starting cell position" I chose column A and row 1 and click "include column headings." I press "OK."
then I enter my credentials which let's say my user name is "abc" and pw is "abc." The server...let's call it "BLUE.TOR.MCFLY.COM."
Could somebody suggest code to automate this? Please and thank you.
The macro recorder doesn't give me any lines of code to work with.
No errors as the macro recorder doesn't work.
As a side note, you can also use open JT400 in java to use DB2 SQL to query your tables.
Using VBA you can also use queries as follows:
The code I am using here is primarily from VBA New Database Connection.
However, of importance to you is your database connection string.
This is using the Client Access ODBC driver to connect to an IBM i DB2 database on a server with the name POWER7 and other options. The "translate" option I believe takes it from the 65535 CSSID and converts it to something nice from EBDIC.
Sub DbConnection()
Dim cn As Object ' ADODB.Connection
Set cn = CreateObject("ADODB.Connection") ' New ADODB.Connection
Dim rs As Object ' ADODB.Recordset
Dim strConn As String
strConn = "DRIVER={Client Access ODBC Driver (32-bit)};" & _
"Database=<myDataBase>;" & _
"Hostname=<POWER7>;" & _
"Port=1234;" & _
"Protocol=TCPIP;" & _
"Uid=<USERID>;" & _
"Pwd=<PASSWORD>;" & _
"SYSTEM=<POWER7>;" & _
"DBQ=QGPL <YOUR BASE LIBRARY> <ANOTHER>;" & _
"DFTPKGLIB=QGPL;" & _
"LANGUAGEID=ENU;" & _
"PKG=QGPL/DEFAULT(IBM),2,0,1,0,512;QRYSTGLMT=-1;" & _
"TRANSLATE=1;" & _
"CONNTYPE=2;" & _
"REGIONAL=NO;"
cn.Open strConn
Dim queryArr, i
queryArr = Array("SELECT * FROM <LIBRARY>.<TABLE>")
For i = LBound(queryArr) To UBound(queryArr)
ExecuteQuery queryArr(i), cn, rs
Next i
cn.Close
Set cn = Nothing
End Sub
Private Sub ExecuteQuery(query As Variant, ByRef cn As Object, ByRef rs As Object)
Set rs = CreateObject("ADODB.Recordset") ' New ADODB.Recordset
With rs
.ActiveConnection = cn
.Open CStr(query)
Sheets("Sheet1").Range("A1").CopyFromRecordset rs
.Close
End With
Set rs = Nothing
End Sub
test this:
Option Explicit
Option Base 1
Sub Firmennamen()
On Error GoTo ERRORHANDLER
Dim sSQLFirmen As String
Dim objListObj As ListObject
Dim objListCols As ListColumns
Set WB = ThisWorkbook
Set ws_Einstellungen = WB.Worksheets("Einstellung") ' tab name in excel
Set objListObj = ws_Einstellungen.ListObjects("FirmenNamen") ' table name in excel
Set objListCols = objListObj.ListColumns
ws_Einstellungen.Range("FirmenNamen").ClearContents ' clear table
sconnect = "PROVIDER=IBMDA400;Data Source=server_name;USER ID=username;PASSWORD=Password;"
conn.ConnectionTimeout = 30
conn.Open sconnect
Set mrs.ActiveConnection = conn
sSQLFirmen = " SELECT t.col1 AS Nr, t.col2 AS Firma " & _
" From server_name.schema_name.table_name t " & _
" WHERE t.col2='010' " & _
" ORDER BY t.col1 "
mrs.Open sSQLFirmen, conn
For i = 0 To mrs.fields.count - 1
objListCols(i + 1).Name = mrs.fields(i).Name
Next i
ws_Einstellungen.Range("FirmenNamen").CopyFromRecordset mrs
mrs.Close
conn.Close
Set mrs = Nothing
Set conn = Nothing
Exit Sub
'get out before the Error Handler kicks in
'//////////////////////////////////////////////////////////
ERRORHANDLER:
Call ERROR
End
End Sub
Private Sub Workbook_Open()
Call Firmennamen ' when excel open --> query update
End Sub
Sub ERROR()
Select Case Err.Number
Case -2147217843
msg = "Sie müssen Ihre User ID und Password eintragen: " & Err.Number _
& " oder Ihre user ID und Password sind nicht correct."
MsgBox msg, vbOKOnly
Case 13
msg = "You have text data in a numeric field (" & BadField & "). Fix and re-Upload"
MsgBox msg, vbOKOnly
Case 1004
msg = "Firma fehlt oder ist ungültig !"
MsgBox msg, vbOKOnly
Case Else
msg = "DIe Fehler ist: " & Err.Number & " / " & Err.Description & vbCrLf & vbCrLf & " Bitte sich bei IT melden (mit Screenshot dieser Meldung) !! :( "
MsgBox msg, vbOKOnly
End Select
Err.Clear
'Set GetConnection = Nothing
End Sub
Getting the "Query too complex" VBA error when trying to run the below code and can't quite seem to figure out why?
Public Sub Update9MonthsDB(ByVal colSelection As Collection)
Dim rs As ADODB.Recordset
Dim strSQL As String
Call Open_Conn(strDb)
Set rs = New ADODB.Recordset
rs.ActiveConnection = CON
rs.CursorType = adOpenKeyset
rs.CursorLocation = adUseClient
rs.LockType = adLockBatchOptimistic
rs.Open ("Select * From [PortfolioDB$]")
For Each Item In colSelection
strSQL = "Grid_Ref='" & Item & "'"
rs.Find strSQL
Debug.Print rs!Grid_Ref
rs("MonthCheck9") = "1"
Debug.Print rs!MonthCheck9
Next Item
rs.UpdateBatch
rs.Close
Call Close_Conn
End Sub
My connection string is used elsewhere in the code and is working fine for normal update/select etc statements. My debug prints show that the collection is not empty and returns the correct value with the other debug value check. But as soon as it gets to rs.UpdateBatch, it crashes out to "Query too complex" error.
EDIT: Just to clarify sorry, this is updating an excel spreadsheet acting as a database (back end)
EDIT: Connection string below as requested in comments.
Sub Open_Conn(strDb As String)
On Error GoTo conError
Debug.Print (Time() & " - Connecting to: " & strDb)
Set CON = New ADODB.Connection
CON.Provider = "Microsoft.ACE.OLEDB.12.0"
CON.Open "Data Source=" & strDb & ";" & _
"Extended Properties=""Excel 12.0 XML;HDR=Yes"""
Debug.Print (Time() & " - Connected")
Exit Sub
conError:
logevents ("There was an error processing the connection: " & strSQL & _
vbNewLine & vbTab & vbTab & vbTab & vbTab & Error(Err))
Resume Next
End Sub
I already have the query that retrieves me the data in a correct way, this is my code.
Sub Main()
Dim sDBPath As String
sDBPath = "C:\Users\ges\Documents\ExploWR.mdb"
Call Query_Access_to_excel(sDBPath, "Explo1", "SELECT eipl.MOD_CODE, eipl.BOM_KEY, eipl.DIF, eipl.PART_NO, eipl.PART_DESC, eipl.QTY_PER_CAR, eipl.INTERIOR_COLOUR, eipl.EXTERIOR_COLOUR, eipl.SOURCE_CODE, eipl.SHOP_CLASS," & _
" eipl.PART_CLASS, eipl.PROCESS_CODE, eipl.OPERATION_NO, eipl.DESIGN_NOTE_NO, eipl.WIP, eipl.PART_ID_CODE, eipl.ADOPT_DATE_Y2K,eipl.ABOLISH_DATE_Y2K, ipo_Modelos.EIM, ipo_Modelos.DEST, ipo_Modelos.MY " & _
" FROM eipl, explo, ipo_Modelos" & _
" WHERE explo.MOD_CODE = eipl.MOD_CODE And explo.MY = ipo_Modelos.MY" & _
" And explo.PLANT = ipo_Modelos.PLANT And eipl.ADOPT_DATE_Y2K <= explo.ADOP " & _
" And explo.DEST = ipo_Modelos.DEST And explo.EIM = ipo_Modelos.EIM")
End Sub
Sub Query_Access_to_excel(sBd As String, sHoja As String, sSQL As String)
On Error GoTo error_handler
Dim rs As ADODB.Recordset
Dim conn As String
Dim Range_Destino As Range
Set Range_Destino = ActiveWorkbook.Sheets(sHoja).Cells(6, 1)
conn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source= " & sBd & ";"
Set rs = New ADODB.Recordset
Call rs.Open(sSQL, conn, adOpenForwardOnly, adLockReadOnly)
If Not rs.EOF Then
Range_Destino.Offset(1, 0).CopyFromRecordset rs
DoEvents
MsgBox "Import Complete", vbInformation
Else
MsgBox "No registers to import", vbInformation
End If
If Not rs Is Nothing Then
If rs.State = adStateOpen Then
rs.Close
End If
Set rs = Nothing
End If
If Not Range_Destino Is Nothing Then
Set Range_Destino = Nothing
End If
Exit Sub
error_handler:
MsgBox Err.Description, vbCritical
End Sub
What I want to do is to correctly place the data in the cells, something like this.
And what I have is something like this. I want to place the data in the correct cells, I'm talking about the last 3 fields to be properly placed in the columns like the first image. I have no idea how to do this without affecting my query.
So as far as exporting the data into excel you have several options:
SQL do command:
https://msdn.microsoft.com/en-us/library/office/ff844793.aspx
Same command but in VBA:
Using Excel VBA to export data to MS Access table
You could iterate through the table and create an array then print that array into a spreadsheet
Once you have the data in excel you're just looking at formatting -- adding some filters, changing the text align, ect.. you can use the "Record Macro" function to perform those tasks and clean the code.
So I guess for clarification - what do you mean 'affecting your query?'
In a nutshell: I'm making a scheduler for my client and, due to constraints, it needs to be in a single excel file (as small as possible). So one worksheet works as the UI and any others will be tables or settings.
I'm trying to use SQL (to which I'm new) to work with the schedule data on a single worksheet (named "TblEmpDays"). So I need to add/update and retrieve records to/from this worksheet. I was able to get a SELECT query to work with some arbitrary data (and paste to a Range). However, I'm not able to get INSERT or UPDATE to work. I've seen it structured as INSERT INTO [<table name>$] (<field names>) VALUES (<data>);. However this gives me a run-time error "'-2147217900 (80040e14)' Syntax error in INSERT INTO statement."
I'm using VBA to write all of this and I made an SQL helper class to make the query execution easier.
To clarify, my question is: How do I need to construct the INSERT and UPDATE queries? What am I missing? I'm trying to post as much related info as possible, so let me know if I missed anything.
Class SQL:
Private pCn ' As Database
Private pResult 'As Recordset
Private pSqlStr As String
Public Property Get Result()
Result = pResult
End Property
Public Function Init()
Set pCn = CreateObject("ADODB.Connection")
With pCn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0 Macro;HDR=YES;ReadOnly=False"";"
.Open
End With
End Function
Public Function Cleanup()
If Not (pCn Is Nothing) Then
pCn.Close
Set pCn = Nothing
End If
If Not pResult Is Nothing Then
Set pResult = Nothing
End If
End Function
Public Function CopyResultToRange(rg As Range)
If Not rg Is Nothing And Not pResult Is Nothing Then
rg.CopyFromRecordset pResult
End If
End Function
Public Property Get query() As String
query = pSqlStr
End Property
Public Property Let query(value As String)
pSqlStr = value
End Property
Public Function Execute(Optional sqlQuery As String)
If sqlQuery = "" Then
sqlQuery = query
End If
If Not pCn Is Nothing Then
Set pResult = pCn.Execute(sqlQuery, , CommandTypeEnum.adCmdText Or ExecuteOptionEnum.adExecuteNoRecords)
Else
MsgBox "SQL connection not established"
End If
End Function
Executing function:
Dim s As SQL ' this is the SQL class '
Dim tbl As String
' rcDay=date string, rcIn & rcOut = time strings, rcVac=boolean string, rcSls=number string'
Dim rcName As String, rcDay As String, rcIn As String, rcOut As String, rcVac As String, rcSls As String
Dim qry As String
tbl = "[TblEmpDays$]"
qry = "INSERT INTO <tbl> (name, date, in, out, vac, sales)" & vbNewLine & _
"VALUES ('<name>', '<date>', '<in>', '<out>', '<vac>', <sales>);"
' Set rc* vars '
s.Init
s.query = Replace(Replace(Replace(Replace(Replace(Replace(Replace(qry, _
"<tbl>", tbl), _
"<sales>", rcSls), _
"<vac>", rcVac), _
"<out>", rcOut), _
"<in>", rcIn), _
"<date>", rcDay), _
"<name>", rcName)
MsgBox s.query
s.Execute
s.Cleanup
I've looked all over an can't find a solution. I'm sure I just haven't searched the right phrase or something simple.
I'm posting the solution here since I can't mark his comment as the answer.
Thanks to #Jeeped in the comments, I now feel like an idiot. It turns out three of my field names were using reserved words ("name", "date", and "in"). It always seems to be a subtle detail that does me in...
I renamed these fields in my worksheet (table) and altered the appropriate code. I also had to Cast the input strings into the proper data types. I'm still working the rest of the details out, but here's the new query:
qry = "INSERT INTO <tbl> (empName, empDay, inTime, outTime, vac, sales)" & vbNewLine & _
"VALUES (CStr('<name>'), CDate('<date>'), CDate('<in>'), CDate('<out>'), " & _
"CBool('<vac>'), CDbl(<sales>));"
I needed the CDate() (instead of the #*#) so I could pass in a string.
So CDate('<date>') instead of #<date>#
Consider using a relational database as backend instead of a worksheet for your project. You can continue to use the UI spreadsheet as a frontend. As a Windows product, the Jet/ACE SQL Engine can be a working solution plus it allows multiple user with simultaneous access (with record-level locking). Additionally, Jet/ACE comes equipped with its own SQL dialect for Database Definition Language (DDL) and Database Maniupulation Language (DML) procedures. And Excel can connect to Jet/ACE via ADO/DAO objects. The only difference of Jet/ACE compared to other RDMS is that it is a file level database (not server) and you cannot create a database using SQL. You must first create the database file using VBA or other COM defined language.
Below are working examples of VBA scripts (Clients and Orders tables) in creating a database with DAO, creating tables with ADO, executing action queries, and copying a recordset to worksheet. Integrate these macros into your project. Use error handling and debug.Print to help develop your app. If you do not have MS Access installed, the .accdb file will show in directory but with blank icon. There will be no user interface to manage the file except via code.
Sub CreateDatabase()
On Error GoTo ErrHandle
Dim fso As Object
Dim olDb As Object, db As Object
Dim strpath As String
Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0"
strpath = "C:\Path\To\Database\File.accdb"
' CREATE DATABASE '
Set fso = CreateObject("Scripting.FileSystemObject")
Set olDb = CreateObject("DAO.DBEngine.120")
If Not fso.FileExists(strpath) Then
Set db = olDb.CreateDatabase(strpath, dbLangGeneral)
End If
Set db = Nothing
Set olDb = Nothing
Set fso = Nothing
MsgBox "Successfully created database!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub CreateTables()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim objAccess As Object
Dim conn As Object
strpath = "C:\Path\To\Database\File.accdb"
' CONNECT TO DATABASE '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
' CREATE TABLES (RUN ONLY ONCE) '
conn.Execute "CREATE TABLE Clients (" _
& " ClientID AUTOINCREMENT," _
& " ClientName TEXT(255)," _
& " Address TEXT(255)," _
& " Notes TEXT(255)," _
& " DateCreated DATETIME" _
& ");"
conn.Execute "CREATE TABLE Orders (" _
& " OrderID AUTOINCREMENT," _
& " ClientID INTEGER," _
& " Item TEXT(255)," _
& " Price DOUBLE," _
& " OrderDate DATETIME," _
& " Notes TEXT(255)" _
& ");"
' CLOSE CONNECTION '
conn.Close
Set conn = Nothing
MsgBox "Successfully created Clients and Orders tables!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub RetrieveDataToWorksheet()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim conn As Object, rs As Object
Dim fld As Variant
strpath = "C:\Path\To\Database\File.accdb"
' OPEN CONNECTION '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
conn.Open constr
rs.Open "SELECT * FROM Clients" _
& " INNER JOIN Orders ON Clients.ClientID = Orders.ClientID;", conn
' COPY FROM RECORDSET TO WORKSHEET '
Worksheets(1).Activate
Worksheets(1).Range("A4").Select
' COLUMN NAMES '
For Each fld In rs.Fields
ActiveCell = fld.Name
ActiveCell.Offset(0, 1).Select
Next
' ROW VALUES '
Worksheets(1).Range("A5").CopyFromRecordset rs
' CLOSE RECORDSET AND CONNECTION '
rs.Close
conn.Close
Set conn = Nothing
Set rs = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub ActionQueries()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim conn As Object
strpath = "C:\Path\To\Database\File.accdb"
' OPEN CONNECTION '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
' APPEND QUERY '
conn.Execute "INSERT INTO Clients (ClientID, ClientName)" _
& " VALUES (" & Worksheets(1).Range("A2") & ", '" & Worksheets(1).Range("B2") & "');"
conn.Execute "INSERT INTO Orders (ClientID, Item, Price)" _
& " VALUES (" & Worksheets(1).Range("A2") & ", " _
& "'" & Worksheets(1).Range("C2") & "', " _
& Worksheets(1).Range("D2") & ");"
' UPDATE QUERY '
conn.Execute "UPDATE Clients " _
& " SET Address = '" & Worksheets(1).Range("E2") & "'" _
& " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"
' DELETE QUERY '
conn.Execute "DELETE FROM Orders " _
& " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"
' CLOSE CONNECTION '
conn.Close
Set conn = Nothing
MsgBox "Successfully updated database!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub