Below is the code to fill a list box in a VBA application :
Private Sub Form_Open(Cancel As Integer)
''#Populate list box control.
Dim cnn As ADODB.Connection
Dim strSQL As String
Dim rst As ADODB.Recordset
Dim strList As String
On Error GoTo ErrHandler
''#Use DSN to Northwind.
''#Modify connection and connection string as needed.
Set cnn = New ADODB.Connection
cnn.Open "DSN=NorthwindExample"
strSQL = "SELECT * FROM Shippers"
Set rst = New ADODB.Recordset
rst.Open strSQL, cnn
strList = rst.GetString(adClipString, , ";", ",")
Debug.Print strList
Me.lstShippers.RowSource = strList
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
ErrHandler:
MsgBox Err.No & ": " & Err.Description, vbOKOnly, "Error"
Set rst = Nothing
Set cnn = Nothing
End Sub
I need to know what i need to put as DSN string? Where will I get the info?
What is adClipString here in this code?
Is there any option to populate list control without using DSN connection object since I am taking the values from the same access table?
Here is a link that contains the different connection strings for Access:
http://www.connectionstrings.com/access
Something like this should work: Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\mydatabase.mdb;User Id=admin;Password=;
Im not sure what adClipString is, it could be an undeclared variable or database column?
Matt
Here is the info on adClipString.
Basically, GetString method gets the content of the entire recordset into a string variable where columns will be separated by ";" and rows will be separated by "," (as per your code).
Regarding DSN - see Start -> Settings -> Control Panel -> Administrative Tools -> Data Sources (ODBC). One of the tab (I guess System DSN) is where ODBC based data source can be created and are listed.
Related
I tried to use Tooling_No_AfterUpdate() for both Sub and Function but it prompt me 'Ambiguous name detected' as I know that I can't use the same identifier. Then, I changed the identifier and set it to public function but it doesn't work and prompt me 'User-defined type not defined'.
I'm creating a form for user to enter the tooling number to know the storage location where it can be more than one location. I tried to use ADODB.Recordset to get data from my asset table. So here's what I tried:
Private Function Tooling_No_Enter() As ADODB.Recordset
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
Set Tooling_No_Enter = CurrentProject.Connection.Execute("select FirstName, LastName from Employees")
End Function
Private Sub Tooling_No_AfterUpdate()
Dim strStorage_Location_1 As String
Dim strStorage_Location_2 As String
Dim strStorage_Location_3 As String
Dim strStorage_Location_4 As String
Dim strStorage_Location_5 As String
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
Set rst = Tooling_No_Enter()
Do While Not rst.EOF
strStorage_Location_1 = rst!Storage_Loacation_1
strStorage_Location_2 = rst!Storage_Loacation_2
strStorage_Location_3 = rst!Storage_Loacation_3
strStorage_Location_4 = rst!Storage_Loacation_4
strStorage_Location_5 = rst!Storage_Loacation_5
Debug.Print strStorage_Location_1 + vbCrLf + strStorage_Location_2 + vbCrLf + strStorage_Location_3 + vbCrLf + strStorage_Location_4 + vbCrLf + strStorage_Location_5
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub
After that, users able to choose the location while the chosen location will be recorded into asset table and transaction table and these are the parts i can't figure it out.
You are using the wrong method to open ADODB recordset. For one thing, Execute is used for action SQL (DELETE, UPDATE, INSERT).
One way to use a recordset object in multiple procedures is to declare recordset variable in module header. Example shows declaring and setting and opening connection and recordset objects which are then referred to in another procedure not shown.
Option Compare Database
Option Explicit
Public strOldLabNum
Dim cn As ADODB.Connection
Dim rsOldSample As ADODB.Recordset
___________________________________________________
Private Sub cbxOldLabNum_AfterUpdate()
Set cn = CurrentProject.Connection
Set rsOldSample = New ADODB.Recordset
strOldLabNum = Me.tbxOldYear & "A-" & Me.cbxOldLabNum
'select old sample info from table zSample
rsOldSample.Open "SELECT * FROM zSample WHERE LabNum='" & strOldLabNum & "';", _
cn, adOpenStatic, adLockPessimistic
End Sub
When running the below code I keep getting an Automation error, for the life of me I can't figure out why. Can anyone shed some light?
When I use the debug it highlights the below;
rs.Open SQLStr, cn
I saw some references to
I've been tasked to get data from a SQL DB based off the values in Column A Row 3 onwards.
Example of Excel Sheet:
ITEM | QTY TO PICK | QTY ON ORDER | Column 2 | Column 3 etc
PART 1 | 5 | <Data will be populated here>
PART 2 | 12 | <Data will be populated here>
This code runs through a Command Button.
The data pulled from SQL will be populated starting in C3 onwards.
Private Sub CommandButton2_Click()
' Create a connection object.
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
' Provide the connection string.
Dim strConn As String
'Use the SQL Server OLE DB Provider.
strConn = "Provider=SQLOLEDB;"
'Connect to the Pubs database on the local server.
strConn = strConn & "server=<server name>;INITIAL CATALOG=<DB Name>;"
'Use an integrated login.
strConn = strConn & " INTEGRATED SECURITY=sspi;"
'Now open the connection.
cn.Open strConn
'
'
ActiveSheet.Range("C3:G10000").Clear ' clear out existing data
Dim ItemNumber As String
ItemNumber = Range("A3").Value
' Create a recordset object.
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
SQLStr = "Select * from vw_WorksOrder WHERE ITEMNO = " & ItemNumber & ""
rs.Open SQLStr, cn
' Copy the records into cell A1 on Sheet1.
Sheet4.Range("C3").CopyFromRecordset rs
' Tidy up
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
As #Zac points out with incorrect use of quotes which resolves issue, consider not using quotes or variable concatenation at all by employing the industry best practice of parameterization. ADO can parameterize SQL calls using its Command CreateParameter method.
See below example using your setup where a ? is used as placeholder in prepared statement, then a parameter is later appended defining its name, type, direction size, and value.
...
Dim cmd As New ADODB.Command
With cmd
.ActiveConnection = cn
.CommandText = "SELECT * FROM vw_WorksOrder WHERE ITEMNO = ?"
.CommandType = adCmdText
.Parameters.Append cmd.CreateParameter("itemparam", adVarChar, adParamInput, 255, ItemNumber)
End With
Dim rs As New ADODB.Recordset
Set rst = cmd.Execute
...
Also, another industry best practice is error and exception handling for runtime errors as AutomationError is not useful for debugging. And you want to release all Set objects regardless of error or not. In VBA, you can use the On Error handling to output more useful messages and release objects from memory accordingly.
Private Sub CommandButton2_Click()
On Error Goto ErrHandle
'...same code but without any Set obj = Nothing (since used in ExitHandle)
ExitHandle:
Set rs = Nothing
Set cmd = Nothing
Set cn = Nothing
Exit Sub
ErrHandle:
Msgbox Err.Number & " - " & Err.Description
Resume ExitHandle
End Sub
I got a brilliant answer to my previous question from #Ryan Wildry but I thought I'd ask a different question regarding the same code: here goes.
Background Info
I have a shared (network/server) Excel template file which is both the input file and the data source (although on different sheets). Let's call that Input.xltm.
The code basically picks up a input in a range on Input Sheet, takes the first two letters and finds the closest code from Code Sheet, then populates a UserForm ListBox with the top five results.
The problem
The problem comes when users set off the UserForm and the error usually returns:
Run-time error '-2147467259'
The Microsoft Access database engine could not find the object 'C:\Users\user.name\Documents\Input1'. Make sure the object exists and that you spell its name and the path name correctly.......etc
I think it may have something to do with the fact Excel puts a number after the filename because it's a template file although I don't actually know!
The code
And here's the code:
Public MyConnection As New ADODB.Connection
Public MyRecordset As New ADODB.Recordset
Private Sub UserForm_Initialize()
Dim ColumnName As String: ColumnName = "[Variant code]"
Dim SearchStr As String: SearchStr = Left(Sheets("Input Sheet").Range("B4").Value2, 2)
Dim dbstring As String
dbstring = ThisWorkbook.FullName
Application.ScreenUpdating = False
If MyConnection.State <> adStateOpen Then
With MyConnection
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbstring & _
";Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=1';"
.Open
End With
End If
If MyRecordset.State = adStateOpen Then MyRecordset.Close
MyRecordset.Open "Select top 5 " & ColumnName & " from [Code Sheet$] where " & ColumnName & _
" like '%" & SearchStr & "%'", MyConnection, adOpenForwardOnly, adLockReadOnly
Me.ListBox1.Clear
If Not MyRecordset.EOF Then MyRecordset.MoveFirst
Application.ScreenUpdating = True
Do Until MyRecordset.EOF
Me.ListBox1.AddItem MyRecordset.Fields(0).Value
MyRecordset.MoveNext
Loop
End Sub
I just need everyone who accesses the file through the server to be able to pick up the correct data source (which is only in the next sheet) and populate the ListBox.
I'd be thankful for any suggestions! Thanks
#UPDATE
I have checked, now if you open (and then save) the actual template file so there's no '1' after the file name, then the code works as expected. It's only when the template is opened normally and the number automatically appended that it stops working.
It seems that you do not make early-binding for MyConnection and MyRecordset first.
You can make a late-binding by
step 1.
Change
Public MyConnection As New ADODB.Connection
Public MyRecordset As New ADODB.Recordset
to
Public MyConnection As object
Public MyRecordset As object
.
step 2.
Add
Set MyConnection = createobject("adodb.connection")
Set MyRecordset = createobject("adodb.recordset")
before If MyConnection.State <> adStateOpen Then
I am using outlook 2010.
When I get an e-mail I need the following to happen:
Check the e-mail address of the sender against my ODBC database:
a. If found then save as .htm in a specific folder and write "1" on the the table's database.
b. If found two times then forward the e-mail to admin#mydomain.org with the subject: "Duplicate to sort manually"
c. If not found then forward it to admin#mydomain.org with the subject: "e-mail to be added to database"
Here is where I am now:
Public Sub ShowMessage(Item As Outlook.MailItem)
'connect to database
On Error Resume Next
Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim cmd As ADODB.Command
Dim sSQL As String
Dim strConn As String
Set cnn = New ADODB.Connection
strConn = "DSN=mydsn;DATABASE=mydb;Trusted_Connection=yes;"
cnn.Open strConn
' Set cmd = New ADODB.Command
' cmd.ActiveConnection = cnn
sSQL = "SELECT id FROM dbo.mailing_list WHERE email_add = '" & Item.SenderEmailAddress & "'"
' cmd.CommandText = sSQL
rst.Open sSQL, cnn, adOpenStatic
email_add = rst!email_add
If rst.BOF And rst.EOF Then
' nothing found
Stop
ElseIf rst.RecordCount > 1 Then
' more than one record
Stop
Else
' one record
'
Dim Path As String
Path = "C:\"
End If
Dim strFromEmail As String
'name and format I want the email to be saved
Item.SaveAs Path, olMHTML
'if email is saved send an alert msg and if not send another one
If Item.Saved = True Then
Item.Delete
Else
MsgBox ("This email was not saved.")
End If
ex:
Set cnn = Nothing
Set cmd = Nothing
Set rst = Nothing
Set rst1 = Nothing
End Sub
Consider implementing the following scenarios:
Create a rule to run a macro which can do #a and #b.
The VBA sub should look like the following one:
Public Sub HandleNewMail(mail As MailItem)
' do something
End Sub
The Outlook object model provides the Forward method for items. It executes the Forward action for an item and returns the resulting copy as a MailItem object. The SaveAs method saves the Microsoft Outlook item to the specified path and in the format of the specified file type. If the file type is not specified, the MSG format (.msg) is used. Pass the olHTML value for the second parameter.
Handle the NewMailEx event of the Application class. It is fired when a new item is received in the Inbox.
It is up to you which way is to choose. But I'd suggest starting from the Getting Started with VBA in Outlook 2010 article in MSDN.
for the SQL-part I would use a separate module; i think the following should work. Use something like
Sub whatsoever()
Dim countsql As Integer
countsql = countemailadress("rechnung.wien#bechtle.com")
Debug.Print "COUNT = " & countsql
End Sub
to call it, then you have the answer in the "countsql" and can use this e.g. in a "case".
here the function:
Function countemailadress(searchforemail As String)
Dim mysql As String
Dim con As ADODB.connection
Dim rec As ADODB.recordset
Set con = New ADODB.connection
con.Open "DSN=mydsn;DATABASE=mydb;Trusted_Connection=yes;"
mysql = "SELECT Count(mailing_list.[email_add]) AS countemail_add FROM mailing_list where (mailing_list.[email_add]=" & searchforemail & ");"
Set rec = con.Execute(mysql)
rec.movefirst
countemailadress = rec.Fields(0)
End Function
I hope this helps,
Max
I've successfully used ExcelADO for reading and importing Excel data into MSAccess during long time reading the entire SpreadSheet.
This time I need to import some table objects that can coexist with other table objects in the same spreadsheet.
According to the documentation http://support.microsoft.com/kb/278973, the only thing that needs to be changed is the From clause in the SQL string:
oRS.Open "Select * from Table1", oConn, adOpenStatic
However this fails and shows the error number mentioned in the title of this thread that essentially says that the object Table1 does not exists in that spreadsheet.
The complete code I'm using is this:
Private Sub Command0_Click()
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim dbs As DAO.Database
Set dbs = CurrentDb
Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\MyPath\MyFile.xlsx;" & _
"Extended Properties= 'Excel 12.0;HDR=Yes';"
rst.Open "Select * From Table1", _
cnn, adOpenStatic, adLockOptimistic, adCmdText
With rst
If Not .EOF And Not .BOF Then
Do Until .EOF
Debug.Print .Fields(0), .Fields(1), .Fields(2)
.MoveNext
Loop
End If
End With
Set rst = Nothing
Set cnn = Nothing
Set dbs = Nothing
End Sub
As I said I can retrieve the whole content of the spreadsheet using:
.Open "Select * From [Sheet1$]", oConn, adOpenStatic
Also I can get the contents of a specified range:
.Open "Select * From [Sheet1$A1:B10]", oConn, adOpenStatic
I double-checked for the existence of that object using VBA, and it's there:
Private Sub Command2_Click()
Dim xlAp As Excel.Application
Dim xlWb As Excel.Workbook
Dim i As Long
Set xlAp = New Excel.Application
Set xlWb = xlAp.Workbooks.Open("C:\MyPath\MyFile.xlsx")
For i = 1 To xlWb.ActiveSheet.ListObjects.Count
Debug.Print xlWb.ActiveSheet.ListObjects(i).Name, _
xlWb.ActiveSheet.ListObjects(i).DisplayName
Next i
Set xlWb = Nothing
Set xlAp = Nothing
End Sub
Does anybody know how to solve this issue?
Thanks in advance,
Diego
Edit:
Well, the error is right in the sense that my object Table1 is not present in the schema as evaluated by using:
Set rs = cnn.OpenSchema(adSchemaTables)
With rs
If Not .EOF And Not .BOF Then
Do Until .EOF
Debug.Print rs.Fields(0), _
rs.Fields(1), _
rs.Fields(2), _
rs.Fields(3)
.MoveNext
Loop
End If
End With
Set rs = Nothing
nor in the tables catalog:
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Set cat = New ADOX.Catalog
cat.ActiveConnection = cnn
For Each tbl In cat.Tables
Debug.Print tbl.Name, tbl.Type
Next tbl
Set cat = Nothing
That's strange considering that the documentation explicitly says:
Named ranges are treated as "Tables" and worksheets are treated as "System Tables,"
So my guess is that Excel 2013 x64 stores named ranges in a different way than before and for accessing them via ExcelADO the syntax needs to be modified in the best scenario or they cannot accessed this way anymore.
As I previously said, the named ranges exist in my spreadsheet and I can loop through them using the range object via automation.
Hopefully someone has an answer to this.
All the best,
Diego
Environ: Windows 7 x64, Access 2013 x64, Excel 2013 x64.
Norie from utteraccess put me in the right path:
In Excel ListObjects aren't named ranges, and what you have is a
ListObject so it's not going to appear in the schema.
So this has nothing to do with the change in the object model; listobjects and named ranges are just different objects even if they appear almost the same for the user.
Didn't find an answer yet for dealing with ListObjects via ExcelAdo, but since that's another question I leave it here: ExcelADO: Fill recordset with ListObject
I have facing the same issue too. I have named range on another sheet that I can query using the named range.
When I open my Name Manager, there is sheets name that have single quote on the name, then query using named range on this sheet will not working.
Then I rename my sheet, then try query again and it's working.
I think my sheets name before conflict with excels default names, which is my sheets name on name manager have single quote