Based on Add/view attachments using MS Access VBA is there a way to act the same way but this time for OLEObjects? How can we replace the AddAttachment method?
Review this reference for method to import OLEObject Import OLEObject. Quite a bit of code involved. Download the sample db and start with review of this proc:
Sub SaveFileToBlob(OLEPath, OLEName)
Dim Tbl As New ADODB.Recordset
Set Tbl = New ADODB.Recordset
With Tbl
.Open "TblEmbeddedObjects", MasterDbConn, adOpenKeyset, adLockOptimistic, adCmdTable
.AddNew
.Fields("fldDocumentName").Value = OLEName
FileToBlob OLEPath & OLEName, .Fields("fldDocument")
.Fields("fldDocumentDate") = Date
.Fields("fldDestinationPath") = Replace(OLEPath, "\\", "\")
.Update
.Close
End With
Set Tbl = Nothing
End Sub
Uses methods AppendChunk and GetChunk. Review Manage OLEObject
Related
We are working on a small VBA code that transmits the content of an e-mail message in Outlook to SharePoint. Our code reads the e-mail and filters out some key components (which are stored in variables). We then use ADODB to create a new item in a SharePoint list.
For that we use the following code:
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim mySQL As String
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
mySQL = "SELECT * FROM [xxxx];"
With cnt
.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;DATABASE=xxxxxx;LIST={xxxxx};"
.Open
End With
rst.Open mySQL, cnt, adOpenDynamic, adLockOptimistic
rst.AddNew
rst.Fields("Titel") = TheName
rst.Fields("ValidFrom") = ValidFrom
rst.Fields("ValidUntil") = ValidUntil
rst.Fields("VersionNr") = Version
rst.Update
If CBool(rst.State And adStateOpen) = True Then rst.Close
Set rst = Nothing
If CBool(cnt.State And adStateOpen) = True Then cnt.Close
Set cnt = Nothing
However, we want to send the attachment of the e-mail (if there is an attachment) also to the sharepoint list, and we are at a loss how to achieve this. After some Googling we found that it is possible to upload the file to a document library, and then use a hyperlink in the sharepoint list to that document. But for us it is possible to have multiple files in one e-mail... Does somebody know a way to achieve this?
I can't keep Access Application Window from displaying when accessing an Access RecordSet from Word VBA.
I have VBA code in Word that creates an Access RecordSet from SQL, manipulates the RecordSet and then closes the Database. I have used Application.ScreenUpdating = False and set the Access Database object .Visible = False, but the Access Application Window keeps flashing on screen for an instant when the code runs.
Code fragment:
Dim acc as Access.Application
Dim db as Database
Dim rst as Recordset
Application.ScreenUpdating = False
Set acc = New Access.Application
With acc
.Visible = False
.OpenCurrentDatabase stAccPath
Set db = .CurrentDb
Set rst = db.OpenRecordset(stSQL)
Other code for manipulating recordset here.
.Quit
End With
set rst = Nothing
Set acc = Nothing
Application.ScreenUpdating = True
What I want to happen is to have Access running invisibly in the background when this code is executed, but in practice, the Access Application window appears on screen for a second before disappearing.
If the code does not need to interact with the user in the Access environment then it's better to not open the database at all. Instead, use an ADO connection retrieve the data directly from data storage, rather than opening the database in Access. This will not only avoid the problem with handling the (unwanted) Access application window, it will also be faster.
Here's some sample code for connecting to an Access database (both mdb and accdb connection strings are provided).
Sub AdoConnectAccess()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConn As String, sSQL As String
'sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\myFolder\myAccessFile.accdb"
'sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\myFolder\myAccessFile.mdb"
sSQL = "SELECT * From [Table Name]"
Set conn = New ADODB.Connection
conn.ConnectionString = sConn
conn.Open
Set rs = conn.Execute(sSQL)
rs.MoveFirst
Debug.Print rs.RecordCount, rs.Fields.Count
Do While Not rs.EOF
Debug.Print rs.Fields("Vorname").value
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
End Sub
Any help with this issue is greatly appreciated.
I am trying to retrieve from Access, by means of Select, multiple values with the same ID and have it pasted into an Excel sheet. I am running the code from Excel VBA.
The query I am using to retrieve said values is:
SELECT Role
FROM Roles
WHERE App_ID=(SELECT ID FROM Apps WHERE NAME='app name');
which is assigned to a variable and afterwards executed by using Set variable = cn.Execute(variable). The problem is that this query, executed from Excel VBA, returns only the first value found. Now, if I run this query from Access it returns every value with the ID for the specified app.
I have tried tried using INNER JOIN, IN, HAVING, etc. but it just wont retrieve all of the values into Excel. Like I said, the query works fine when used in Access so I know this must be limitation in Excel.
Thank you for any help you guys can provide.
Assuming you are using ADODB in Excel, keep in mind that the Execute function returns a Recordset. You can loop through the Recordset to see the additional rows.
Set rng = ActiveSheet.Range("A2")
Set rst = cn.Execute(strSQL)
With rst
Do While Not .EOF
rng = CStr(!Role)
Set rng = rng.Offset(1)
.MoveNext
Loop
End With
'Applies to Access 2010
'Reference Microsoft ActiveX Data Objects 6.1 Library
Dim strSQL As String
Dim strDBPathName As String
Dim strConProvider As String
Dim strPersist As String
Dim conADODB As ADODB.Connection
Dim rsADODB As ADODB.Recordset
Set conADODB = New ADODB.Connection
strConProvider = "Provider=Microsoft.ACE.OLEDB.12.0;"
'Database path name
strDBPathName = "Data Source=C:\Temp\Database.accdb;"
strPersist = "Persist Security Info=False;"
With conADODB
.ConnectionString = strConProvider & strDBPathName & strPersist
.Open
End With
strSQL = "SELECT Role FROM Roles WHERE App_ID=(SELECT ID FROM Apps WHERE NAME='app name')"
Set rsADODB = New ADODB.Recordset
With rsADODB
.Open strSQL, conADODB, adOpenStatic, adLockPessimistic
If Not (.EOF And .BOF) Then
'Range of spreadsheet to paste records
Cells(1, 1).CopyFromRecordset rsADODB
End If
.Close
End With
Set rsADODB = Nothing
conADODB.Close
Set conADODB = Nothing
I have been searching for a way of duplicating or copying a recordset in VBA. And by that I mean, having the undelying data independent of each other.
I have tried
Set copyRS = origRS.Clone
Set copyRS = origRS
When I use any of the methods I cant modify one recordset without modifying the other. So in this example:
I create a recordset
I populate the recordset with the name John
I clone the recordset
I modify the cloned one
Check result
Code:
Dim origRS As Recordset, copyRS As Recordset
Set origRS = New Recordset
'Create field
origRS.Fields.Append "Name", adChar, 10, adFldUpdatable
origRS.Open
'Add name
origRS.AddNew "Name", "John"
'Clone/copy
Set copyRS = origRS.Clone
'Change record in cloned/copied recordset
copyRS.MoveFirst
copyRS!Name = "James"
'This should give me "JamesJohn"
MsgBox copyRS.Fields(0).Value & origRS.Fields(0)
But unfortunately for me, this modifies both recordsets
My question is:
Is there a way of copying a recordset from another recordset and then modify the data independently of each other (without looping)?
I know that evidently you can do it through a loop, but is there no other way?
++ Good question! btw. this way of copying object is called a deep copy.
I usually get away with creating an ADODB.Stream and saving the current recordset into it.
Then you can use the .Open() method of a new recordset and pass the stream to it.
For example:
Sub Main()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Fields.Append "Name", adChar, 10, adFldUpdatable
rs.Open
rs.AddNew "Name", "John"
Dim strm As ADODB.Stream
Set strm = New ADODB.Stream
rs.Save strm
Dim copy As New ADODB.Recordset
copy.Open strm
copy!Name = "hellow"
Debug.Print "orignal recordset: " & rs.Fields(0).Value
Debug.Print "copied recordset: " & copy.Fields(0).Value
strm.Close
rs.Close
copy.Close
Set strm = Nothing
Set rs = Nothing
Set copy = Nothing
End Sub
Results as expected:
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