I have a bit of a complex Access Database that I need to do some audio recording with. I have nearly everything working using outside solutions but I am forced to select my input device from within Access.
All that I need is some way to get a collection of devices or something from Windows and I can take it from there. http://www.vbmonster.com/Uwe/Forum.aspx/vb/32848/listing-all-audio-devices does something close to what I am looking for except that is the output instead of the input. I know that there will be no extremely easy way to accomplish this but I know it is possible, I just can't seem to find how.
The code you linked creates a SWbemObjectSet, then lists properties of its members (sound devices). From what I can tell, you want that object but don't want to list the properties ("output").
If that is correct, create a function which strips away the output statements and just returns the SWbemObjectSet object.
Public Function getSoundDevices(Optional strComputer As String = ".") As Object
Const cstrQuery As String = "Select * from Win32_SoundDevice"
Dim objWMIService As Object 'TypeName = SWbemServicesEx '
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set getSoundDevices = objWMIService.ExecQuery(cstrQuery, , 48)
Set objWMIService = Nothing
End Function
Then call the function to use the SWbemObjectSet as input for your other code.
Public Sub test_getSoundDevices()
Dim objSoundDevices As Object 'TypeName = SWbemObjectSet '
Dim objDevice As Object 'TypeName = SWbemObjectEx '
Set objSoundDevices = getSoundDevices()
For Each objDevice In objSoundDevices
'* do what you want for each sound device here *'
Debug.Print "ProductName: " & objDevice.ProductName
Next objDevice
Set objDevice = Nothing
Set objSoundDevices = Nothing
End Sub
Hmm, not the easiest question :-) I think you indeed need to invoke a native function.
Maby something like this:
http://msdn.microsoft.com/en-us/library/ms645598(v=vs.85).aspx
VB implementation in the bottom.
Good luck!
Related
I'm trying to understand how to work with the new Attachment field that is available in Access 2010. I would like to assign the value from the table directly into a variable. I know that I can do this if I use an intermediary form, but this seems like sloppy coding to rely on a form in order to grab a value from a table. Is there some way to grab what is in an attachment field and assign it directly to a variable? I have multiple instances where this would be handy for me. The first instance is I want to grab a photo stored in an attachment field to assign to the ribbon. A second instance is to load a company logo from a table into a variable and keep it in memory to use throughout the program as needed.
The code I have so far is this, but it gives me a type mismatch error:
Dim ParentRS As Recordset, ChildRS As Recordset, Img As Attachment
Set ParentRS = CurrentDb.OpenRecordset("SELECT * FROM LtblImg;", dbOpenSnapshot)
If ParentRS.RecordCount > 0 Then
Set ChildRS = ParentRS("Img").Value
If ChildRS.RecordCount > 0 Then
Set Img = ChildRS("FileData")
End If
ChildRS.Close
End If
ParentRS.Close
Yes, Dim Img As Attachment looks tempting, but Attachment (which is actually Access.Attachment) refers to an Attachment control that could be used on a form (just like Access.TextBox) and does not appear to be suitable for your intended purpose.
The only native VBA type for storing this sort of binary data is an array of Byte values, but often when dealing with byte arrays we wind up looping through and processing them byte-by-byte, which is tedious and inefficient.
You might consider using a binary ADODB.Stream object as your "variable". You could create a function to retrieve the attachment bytes and return them in a Stream like so
Option Compare Database
Option Explicit
Public Function GetLogoAsStream() As ADODB.Stream
Dim cdb As DAO.Database, rstMain As DAO.Recordset, rstAttach As DAO.Recordset2, fldAttach As DAO.Field2
' Project references required for early binding:
' Windows Script Host Object Model
' Microsoft ActiveX Data Objects 2.8 Library
Dim fso As FileSystemObject, tempFileSpec As String
Static strm As ADODB.Stream
If strm Is Nothing Then
Set fso = New FileSystemObject
tempFileSpec = fso.GetSpecialFolder(TemporaryFolder) & "\" & fso.GetTempName
Set fso = Nothing
Set cdb = CurrentDb
Set rstMain = cdb.OpenRecordset( _
"SELECT [AttachmentFiles] " & _
"FROM [AttachmentsTable] " & _
"WHERE [Description]='SO logo'", _
dbOpenSnapshot)
Set rstAttach = rstMain("AttachmentFiles").Value
' make sure we use the correct file extension
tempFileSpec = tempFileSpec & "." & rstAttach.Fields("FileType").Value
Set fldAttach = rstAttach.Fields("FileData")
fldAttach.SaveToFile tempFileSpec
Set fldAttach = Nothing
rstAttach.Close
Set rstAttach = Nothing
rstMain.Close
Set rstMain = Nothing
Set cdb = Nothing
Set strm = New ADODB.Stream
strm.Type = adTypeBinary
strm.Open
strm.LoadFromFile tempFileSpec
Kill tempFileSpec
End If
strm.Position = 0
Set GetLogoAsStream = strm
End Function
and then if you had, say, a Report like this with an empty Image control
and an On Load event procedure like this to load the Image control's .PictureData from your "variable" (actually a Function returning an ADODB.Stream)
Private Sub Report_Load()
Me.LogoImage.PictureData = GetLogoAsStream.Read
End Sub
it could produce something like this
Microsoft Word is offering some default document properties to be set in Word documents.
There is a number of default properties, for which vbscript has constants.
But Word (2011) is offering some more properties, e.g. companyfaxnumber, publishingdate,keywords.
There is a possibility to access the builtin properties by calling
Set oWord = CreateObject("Word.Application")
oWord.Visible = True
oWord.Documents.Open(strFilePath)
For Each prop In oWord.ActiveDocument.BuiltInDocumentProperties
WScript.Echo prop.Name + "::" + oWord.ActiveDocument.BuiltInDocumentProperties(prop.Name).Value
Next
But how do i find the names of the "custom" properties that are offered by word, but are not present in vbscript as constant?
There is the function
Document.CustomDocumentProperties
But if i do a listing like the one above, i get properties named info1, info2, etc.
Too access the Word CustomDocumentProperties, you will need to be able to access the OLE File Property Reader. This expands beyond the normal/simple document properties because it allows you too add custom properties as well.
There is a Tales from the Script article from 2005 detailing the installation and usage of utilizing CustomDocumentProperties within Word -> Here
For the download to install the OLE Property Reader DLL, Go -> Here
Here is an example of property set/get once the property read is installed:
Const msoPropertyTypeBoolean = 2
Set objFile = CreateObject("DSOFile.OleDocumentProperties")
objFile.Open("C:\Scripts\New_users.xls")
'Set
'=======================================================================
objFile.CustomProperties.Add "Document Reviewed", msoPropertyTypeBoolean
objFile.Save
'Get
'=======================================================================
Set objProperty = objFile.CustomProperties.Item("Document Reviewed")
wscript.echo objProperty.Value
Enjoy!
Hi recently figured out how to get there myself:
The Word "Frontend Editor" is cheating on the document properties. There is a hard defined set of properties like author,category, keywords etc.
The additional properties offered by the editor are so called custom properties which are defined in an external XML structure inside the docx-container.
So there is no easy vbscript function to modify the values of these custom properties.
Thanks to the web, someone did some hacking and this is the solution for it:
Sub WriteCustomCoverProperties(ByRef wordInstance, strProp, strText)
Dim oCustPart
Dim oNode
Dim strXPath
strProp = Replace(strProp, " ", "")
Select Case strProp
Case "Abstract" strXPath = "/ns0:CoverPageProperties[1]/ns0:Abstract[1]"
Case "PublishDate" strXPath = "/ns0:CoverPageProperties[1]/ns0:PublishDate[1]"
Case "CompanyAddress" strXPath = "/ns0:CoverPageProperties[1]/ns0:CompanyAddress[1]"
Case "CompanyPhone" strXPath = "/ns0:CoverPageProperties[1]/ns0:CompanyPhone[1]"
Case "CompanyFax" strXPath = "/ns0:CoverPageProperties[1]/ns0:CompanyFax[1]"
Case "CompanyEmail" strXPath = "/ns0:CoverPageProperties[1]/ns0:CompanyEmail[1]"
Case Else
Exit Sub
End Select
Set oCustPart = wordInstance.ActiveDocument.CustomXMLParts(3)
Set oNode = oCustPart.SelectSingleNode(strXPath)
oNode.Text = strText
Set oCustPart = Nothing
Set oNode = Nothing
End Sub
May it be of help =)
I'm having problems building a collection of data. The problem code is as follows:
'Basic defitions are as follows:
Private mCol As Collection
Dim mcnn As ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim uCustomClass As CustomClass
On Error GoTo 0
'set Find to false to catch any errors
Find = False
'checks for an active connection and then..
Set mCol = Nothing
Set mCol = New Collection
With mrs
.Open AN_SQL_SELECT_STATEMENT , mcnn, adOpenForwardOnly, adLockOptimistic
While Not .EOF
Set uCustomClass = New CustomClass
Set uCustomClass.Connection = mcnn
uCustomClass.CustomerName = NullToEquiv(.Fields("customer_name").Value,NULL_STRING)
uCustomClass.NumberOfOrders = NullToEquiv(.Fields("num_of_orders").Value, NULL_LONG)
uCustomClass.FavoriteColour = NullToEquiv(.Fields("favorite_colour").Value, NULL_STRING)
'Cache orginal values in case the keys change
uCustomClass.CacheOriginalValues
'add to collection
mCol.Add uCustomClass
.MoveNext
Wend
Now the result of this in run time is that the uCustomClass tree structure looks like:
-uCustomClass
+connection
count
+ mcnn
-mCol
+Item1
+Item2
+Item3
+mrs
mvarChangedCount
+NewEnum
It's all good bar I'm not getting Item1, Item2 and Item3 directly under the uCustomClass but only in mCol. I've what appears to be the exact same code running elsewhere for a different custom class and I'm getting what I want e.g.
-uCustomClassThatWorks
+connection
count
+ mcnn
-mCol
+Item1
+Item2
+Item3
+mrs
mvarChangedCount
+NewEnum
+Item1
+Item2
+Item3
Any ideas where the problem might be?
Not sure how uCustomClass would ever get those items added. Is there some missing code or something?
One point worth making is that collections can't have the same keys more than once, which would explain why they are able to be added in one area, but not able to be added again. There might be something that is even trimming strings or something that would aggravate the situation. So just make sure your keys are unique.
I am using the following script to grab parcel and address information from one layer to fill the attribute table of a newly created feature.
There is no returned error, but the problem I am having is that there seems to be the wrong information stuck in the memory of recordselect function. No matter where I place a point it gives the same parcel # and address. Or maybe it isn’t actually be performing the IF function properly.
Sub Address
Dim rsCurrentXY
Set rsCurrentXY = Map.Layers("Violations").records
rsCurrentXY.movelast
Dim objXYShape
Set objXYShape = rsCurrentXY.Fields.Shape
Dim pControls
Set pControls= Application.Map.selectionlayer.Forms("EDITFORM").Pages(“PAGE1”).Controls
Dim rsGrid
' Find corresponding map page to the valve point
Set rsGrid = Map.Layers("ACPA_parcels").records
rsGrid.movefirst
Do While Not rsGrid.eof
If rsGrid.fields.shape.Ispointin(objXYShape) Then
pControls("txtAddress").value = rsGrid.Fields("ADD1").Value
Exit Do
End If
rsGrid.Movenext
Loop
' Clean Up
Set rsCurrentXY = Nothing
Set objXYShape = Nothing
Set rsGrid = Nothing
End Sub
(I have another subroutine called "PIN" that would do the exact same thing.)
I have them called when their respective edit boxes in the custom form are activated by the inspector.
Thanks for the help,
Robert
Accessing the EDITFORM via Application.Map.selectionlayer.Forms("EDITFORM") will be problematic. Whenever working with controls on an EDITFORM you should using ThisEvent.Object to discover all your objects. For example, if your event handler is Page_OnLoad then ThisEvent.Object will refer to your current page. You should have code like this:
Dim pPage1
Set pPage1 = ThisEvent.Object
Dim pControls
Set pControls = pPage1.Controls
the function should just take connection string and a SQL query as input and it should connect to any database(SQL, ORACLE, SYBASE, MS ACCESS) and execute any query which i have passed as the parameters to the function.
I have written the below function for that task, Can you please check this once and tell me is this correct or pls tell me if i am wrong anywhere.
#
Public Function ConnectDB (strCon, strQuery)
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
objConnection.Open strCon
objRecordSet.Open strQuery,objConnection
objRecordSet.MoveFirst
Do Until objRecordset.EOF
Msgbox "Number of records: " & objRecordset.RecordCount
Msgbox objRecordset(0)
Msgbox objRecordset(1)
objRecordset.MoveNext
Loop
objRecordSet.Close
objConnection.Close
Set objConnection = Nothing
Set objRecordSet = Nothing
End Function
#
Call ConnectDB ("Provider = Microsoft.Jet.OLEDB.4.0; " & _
"Data Source = inventory.mdb","SELECT * FROM EMP ORDER BY EMPName")
UPDATE:
Thank you so much for the replies.
Actually i have been asked to write a function which performs the task of connecting to any database and executing any query(given by user) in that connected database.
I have started to learn VBScript and want to have indepth knowledge of writing functions. Ekkehard horner can you please tell me where can i read to get know all about routines(functions and sub procedure). Presently, i have only the basic idea on routines and i referred MSDN, where they have given only basic information. Please help me where to study more about routines. It is so difficult to write programs without knowing about them correctly.
Hi Sanpaco, below is the class i wrote. Please check it once and let me know the corrections.
I am very new to VBScript.Suggest me ways to improve my programming knowledge.
Class DBCommunicator
Public Function DBConnect(StrCon)
Option Eplicit
Dim oConn
set oConn = CreateObject("ADODB.Connection")
oConn.Open Strcon
Function DBConnect = True
End Function
Public Function QueryDB(StrQuery)
Option Eplicit
Dim oRst, oField
set oRst = CreateObject("ADODB.recordset")
oRst.Open "StrQuery", oConn
Do Until oRst.EOF
For each oField in oRst.Fields
Print oField.Name & " = " & oField.Value
Next
oRst.MoveNext
loop
Public Function DBdisConnect
oRst.close
oConn.close
End Function
End Class
########################################
Option Explicit
Dim strResult
strResult=DBCommunicator.DBConnect("<<Connection String of any database User want to connect>>")
If strResult<>True Then
wscript.echo "DB Connection Failed"
End If
DBCommunicator.QueryDB("Select * from EMP")
DBCommunicator.DBdisConnect
I fixed your code, not sure I agree with it but it seems to work. I don't think VB Script recognizes classes.
Option Explicit
'https://stackoverflow.com/questions/8429313/a-generic-vbscript-function-to-connect-to-any-database-and-execute-any-sql-query
'https://www.connectionstrings.com/microsoft-sql-server-odbc-driver/
Dim oConn, oRst
Public Function DBConnect(StrCon)
set oConn = CreateObject("ADODB.Connection")
oConn.Open Strcon
DBConnect = True
End Function
Public Function DBQuery(StrQuery)
Dim oField
set oRst = CreateObject("ADODB.recordset")
oRst.Open StrQuery, oConn
Do Until oRst.EOF
For each oField in oRst.Fields
wscript.echo oField.Name & " = " & oField.Value
Next
oRst.MoveNext
Loop
End Function
Public Function DBdisConnect
oRst.close
oConn.close
End Function
Dim strResult
strResult=DBConnect("<<Connection String of any database User want to connect>>")
If strResult<>True Then
wscript.echo "DB Connection Failed"
End If
DBQuery("Select * from EMP")
DBdisConnect
A routine (Sub or Function) should do exactly one repeatable/reusable task. Your
Function creates, opens, and closes a connection, creates, uses, and closes a
recordset, and annoys the user with message boxes. If you want to do something
sensible tomorrow, you'll have to write (by copy & paste & modify) another
routine.
A Function should return a value; yours doesn't. A Function should have no
side effects; yours does by doing IO. The work/doings of a routine should
be determined by its parameters alone; yours depends on the default settings/values
for the numerous parameters to the .Open methods you don't provide.
Code should not contain fat; .MoveFirst before a .EOF loop, displaying the
.RecordCount in the loop, and setting object variables to Nothing immediately
before the routine's end is just that. VBScript code should start with "Option
Explicit"; yours obviously doesn't.
While independency of a specific DBMS is attractive when you are learning
or investigating, a professional solution for a real world problem should
be based on the decision for the 'best' DBMS for the task; this will lead
to DBMS specific code using DBMS specific features. Then the switch from
one DBMS to another by changing just the ConnectionString is illusionary.
Database work is either of the "connect-do one thing-disconnect" style of
.Net's ADO or of the "connect on start-do many different things-disconnect on
termination" style of 'classical' ADO. If you indicate, what kind of tasks
you have in mind, I may be willing to append to this answer.
You might consider creating a DatabaseCommunicator class that does separate database functions (Connect, ExecuteQuery, Disconnect) instead of trying to do everything with one method. Also if you are wanting to use different types of providers dynamically then you would need to validate the query format to make sure it uses the correct syntax for whatever provider you are using.
I would be very interested in seeing how you accomplish this task should you take it on.