Access 2010 - Store JPG as OLE Object using filename path from field in same record - blob

I have scoured the net for days trying to figure this out, but apparently my gaps in Access are too severe and the answer eludes me. Someone has apparently already answered this question, however I'm not able utilize the information.
My specific situation:
Table1 has 30,000+ rows and multiple columns. "Photo Path" is a text field with the path and filename of an image. "Photo" is an OLE Object field currently empty.
What I would like to do is store the image specified in "Photo Path" as an OLE object in "Photo".
Table1 Current State:
Name - Photo Path - Photo
Impala - C:\Cars\Impala.jpg -
Jeep - C:\Cars\Jeep.jpg -
Table1 Desired Result:
Name - Photo Path - Photo
Impala - C:\Cars\Impala.jpg - LONG BINARY DATA
Jeep - C:\Cars\Jeep.jpg - LONG BINARY DATA
I don't know how to execute FileToBlob() against my entire database using the generously provided code. The authors seem to expect me to use a form, which I was unable to get to work as well.
What I think I want is an SQL statement that will execute against every row in Table1 using FileToBlob() or something close to it.
I've tried variations of the following statement in the SQL Query to no avail.
SELECT Table1.[Photo Path], FileToBlob(Table1.[Photo Path],Table1.Photo) As Photo
FROM Table1;
Thank you for taking the time to read this and providing an answer.

Had to figure this one out for myself as there were no responses. For those may follow looking for an actual answer, here it is.
I modified the code that that I found to fit my specific problem.
Create a new module and put the code below in it. If by chance the code does not work, you can try going to Tools-->References and if not already selected, select "Microsoft DAO X.x Object Library" where X.x is the latest library. If it still doesn't run you'll have to check to see if you need to select any other references.
There are so many records to go through, I felt better doing this through code instead of a query that may take a long time to execute and one won't know what is going on. In the code I have it writing to the status bar in Access so you know where you are at (but if the files are small it will probably fly by, but at least you know it is working).
To run the code, just put your cursor anywhere in the routine and I first like to press F8 which steps into the code just to make sure I'm in the right routine. Then press F5 to run the rest of the code. If you want to create a form to run the code instead you can do that too. Just create a button and on the "on click" event add the code:
call Load_Photo()
If you want to see the status updates, make sure the main access window is visible before you run the code (If you run from a form, it will already be there).
Note I renamed the field "Name" in Table1 to "strName" because "Name" is a reserved word. I'd suggest not using "Name" as a field name. You might be OK, but you could run into issues at some point, especially when referencing the field through code. If you choose not to change the field name, change the code.
Also note that the sample code provided stored as a binary. So if you create an Access form to show the records, the image will not automatically appear - there is some other manipulation necessary that I am not familiar with off hand.
Without further ado, here's the code to solution I was looking for:
Option Compare Database
Option Explicit
Public Sub Load_Photo()
On Error GoTo LoadFileError
Dim strSQL As String
Dim rstTable As DAO.Recordset
Dim strStatus As String
Dim count As Integer
Dim strFile As String
Dim nFileNum As Integer
Dim byteData() As Byte
Dim varStatus As Boolean
'
' In case something happens part way through the load, just load photos that have not been loaded yet.
'
strSQL = "Select [strName], [Photo Path], [Photo] from Table1 Where [Photo] is null"
Set rstTable = CurrentDb.OpenRecordset(strSQL)
If rstTable.RecordCount > 0 Then
rstTable.MoveFirst
count = 0
Do While Not rstTable.EOF
strFile = rstTable![Photo Path]
If Len(Dir(strFile)) > 0 Then
nFileNum = FreeFile()
Open strFile For Binary Access Read As nFileNum
If LOF(nFileNum) > 0 Then
count = count + 1
'
' Show user status of loading
'
strStatus = "Loading photo " & count & " for " & rstTable![strName] & ": " & rstTable![Photo Path]
varStatus = SysCmd(acSysCmdSetStatus, strStatus)
DoEvents
ReDim byteData(1 To LOF(nFileNum))
Get #nFileNum, , byteData
rstTable.Edit
rstTable![Photo] = byteData
rstTable.Update
Else
MsgBox ("Error: empty file, can't load for Name = " & rstTable![strName] & " and Photo Path = " & rstTable![Photo Path])
End If
Close nFileNum
Else
MsgBox ("Error: File not found for Name = " & rstTable![strName] & " and Photo Path = " & rstTable![Photo Path])
End If
rstTable.MoveNext
Loop
End If
LoadFileExit:
If nFileNum > 0 Then Close nFileNum
rstTable.Close
strStatus = " "
varStatus = SysCmd(acSysCmdSetStatus, strStatus)
Exit Sub
LoadFileError:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error on " & strFile
Resume LoadFileExit
End Sub

Related

Word VBA: Static Status dialog window

I've created a form that works well with macros running in the background to validate data and then print the document to a specific printer on the network.
The key element of this process is a production number value which I would like to keep a running log of and display in a static status dialog window. In other words, a popup window similar to a MsgBox that would not interfere with other actions on the form, but float on top of the document.
Visual concept of this would be...
User could shift the window away from their work if needed. Close the window if they desired, but pragmatically I want to re-pop/refresh the data in the window each time the background macro completes.
I can't use MsgBox, because it forces a closure of the window before the user can continue working on the document. I just want this visible to the user so they know what was last worked on and the few prior to that.
Any idea what control I might be able to use, or switch to MsgBox that would allow the user to continue working?
Ken...
PS: I found this and am trying to find a way to make this work for me. So far I have managed to get to function in the manner I want, but the lingering issue is how to call this PS script and include the information I need to display.
Alternatives to MsgBox in VBScript - StackOverflow
PPS: I opted to go a slightly different route and release the form with a MsgBox that is displayed at the end of the macro. I describe this in the solution noted below.
Instead of using a MsgBox, please consider using a VBA Userform. They're not much more complicated to use than a MegBox, but you can set them to be Modeless. Modeless dialogs remain open on-screen while you work on the Word document. Here'is Microsoft's page on setting dialogs as Modal or Modeless: Show method
If you search on VBA modeless dialog, you'll find many other helpful pages on the subject.
After doing much research, I've come back to revising my macro to incorporate static variables and a MsgBox at the end to report the last 5 production numbers that have been printed.
To provide a means of bringing up this MsgBox for reference, between printing runs, I created an OnlyNum variable as string and replaced the MsgBox I had for letting the users know they were only to use numbers in this field with that message. The end of that trap diverted the flow to the bottom of the macro (where the MsgBox that displayed the last five print jobs has been placed).
So, when the status MsgBox is displayed as a result of printing it only shows the last five events. If the trap captures it, it shows the message letting the user know to only use numerals and then displays the last five events.
Code reference:
Private Sub CommandButton1_Click()
Dim Prod As String
Dim Temp As String
Dim OnlyNum As String
Static ProdNum1 As String
Static ProdNum2 As String
Static ProdNum3 As String
Static ProdNum4 As String
Static ProdNum5 As String
'Check for only numeric value of TextBox1.Text
If Not IsNumeric(TextBox1.Value) Then
OnlyNum = "only numbers allowed" & vbCrLf & vbCrLf
Cancel = True
GoTo NotToday
End If
'Remove any spaces from TextBox1.Text
Prod = Replace(TextBox1.Text, " ", "")
'If the resulting lenght is equal to 7 Print it.
If Len(Prod) = 7 Then
ActiveDocument.PrintOut
'Update recent production numbers (5 in total)
ProdNum5 = ProdNum4
ProdNum4 = ProdNum3
ProdNum3 = ProdNum2
ProdNum2 = ProdNum1
ProdNum1 = Prod & " - " & Now() ' Insert a new production number with timestamp
TextBox1.Text = "" 'Clear the value of TextBox1.Text to prepare for the next Production number
Else
MsgBox ("Production Numbers must be 7 digits and contain only numerials.")
End If
NotToday:
Application.ActivePrinter = Temp
MsgBox (OnlyNum & ProdNum1 & vbCrLf & ProdNum2 & vbCrLf & ProdNum3 & vbCrLf & ProdNum4 & vbCrLf & ProdNum5)
OnlyNum = "" 'Reset value of OnlyNum
End Sub

MS Access - SetFocus on multiple text boxes to check if data exists via SQL

The problem I'm facing:
I try to check if inserted text from multiple text boxes is already existing in a table before saving the records to avoid duplicates.
I created a form to enter new members and save them into a table. The key to avoid duplicates is to check the combination of given name, last name and birth date with existing records. (It's most likely that there won't be two person with all three criteria matching)
I have no problem to check the existence for only one text box by setting the focus on the desired box and use the SQL query IF EXISTS...
But since I would need to set focus on several text boxes(IMO) the problem occurs.
Is there a way to set focus on multiple text boxes?
The idea would be to use an IF EXISTS...AND EXISTS statement and I would need to implement the .SetFocus statement for each text box before checking its existence.
I hope you get my point and I would be glad if someone could share some knowledge. :)
Thanks in advance
There seems to be some missing information in order to find the best solution to your problem. so the below response will be based on assumptions as to how your form is working.
I'm assuming you are using an unbound form with unbound text boxes? if this is the case, then you must have a button that is the trigger for checking/adding this information to your table. lets say your command button is called "Save". You can use the following code without the need to .setfocus to any textbox.
Private Sub Save_Click()
Dim db as DAO.Database
Dim rst as DAO.Recordset
Dim strSQL as string
set db = currentdb 'This is the connection to the current database
'This is the SQL string to query the data on your table
strsql = "SELECT * " & _
"FROM [Yourtablename] " & _
"WHERE ((([YourTableName].[FirstName]) ='" & me.FormFirstNameField & "' AND ([YourTableName].[LastName]) ='" & me.FormLastNameField & "' AND ([YourTableName].[DOB]) =#" & me.FormDOBField & "#));"
set rst = db.openrecordset(strsql) 'This opens the recordset
if rst.recordcount <> 0 then
'Enter code to inform user information already exists
else
'Enter code if information does not exits
end if
rst.close 'Closes the recordset
set rst = nothing 'Frees memory
set db = nothing 'Frees Memory
End Sub
Let me know if this code works or if I need to make changes based on your scenario.

Inserting data to other xls workbook via ADO & SQL – Data type error

I am building a quite complex UserForm that uses ADO connection to connect to another Excel workbook that serves as a database and retrieve & insert data via SQL queries. Please note I am not allowed to use Access in this case.
I have already figured out how to use SELECT, but there is one particular error with INSERT I can't resolve. That bothers me a lot, I've put a lot of work to it.
First the connection (I use JET for retrieving data and ACE for saving data as I was not able to get JET to work for that):
Public Sub InsertDataToSheet(SQLCmd As String)
Dim cnx As Object
Set cnx = CreateObject("ADODB.Connection")
cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source='" & ThisWorkbook.Path & "\Database.xls'; Extended Properties=Excel 12.0;"
cnx.Execute SQLCmd
cnx.Close
End Sub
Then there is a subroutine linked to a Submit button that actually generates the Query as I need to save only filled out Textboxes and Combos to avoid Nulls:
Private Sub SaveRecord()
Dim SQL As String
SQL = "INSERT INTO [Report$A2:AM50000] ("
Dim i As Control
For Each i In Me.controls
If TypeName(i) = "TextBox" Or TypeName(i) = "ComboBox" Then
If i <> e Then SQL = SQL & i.Name & ","
End If
Next i
SQL = Mid(SQL, 1, Len(SQL) - 1) & ") VALUES(" ' Remove last space & comma
Dim j As Control
For Each j In Me.controls
If TypeName(j) = "TextBox" Or TypeName(j) = "ComboBox" Then
If j <> e Then
If j = "Unknown" Then MsgBox "Fire"
Select Case IsNumeric(j)
Case False
SQL = SQL & "'" & j & "'" ' Add single quotes around strings
Case True
SQL = SQL & j
End Select
SQL = SQL & ","
End If
End If
Next j
SQL = Mid(SQL, 1, Len(SQL) - 1) & ")" ' Remove last comma
' Connect
InsertDataToSheet (SQL)
End Sub
There are two particular textboxes in the form that work exactly the same. Normally, users enter numbers to them and everything saves fine (don't mind the '+' buttons):
Sometimes, however, users do not know the values but can't leave those empty. That's when they are supposed to tick the checkboxes to set the value(s) to 'Unknown':
Now there comes the funny part – for the Batch field, it saves fine. But when I set the Shipment ID to 'Unknown' (or any other string), it throws an error:
Note the fields are not Disabled, just Locked with some appearance changes. I was also unable to find any specific details about the error, but it seems there is some problem with the query:
(It says something like 'Incompatible data types in the expression'). The generated query is this:
Any ideas what goes wrong? I'd very much like to keep the functionality as it is know and solve the error rather than redesign it as it already took some effort and the fields can't stay empty.
Never used sql in xls workbooks, but I had this problem with SQL server already. There's nothing "wrong" with your query, the problem is that data type that's accepted on the field of the table you want to insert. Try to turn that field to use text values instead of numbers and it should work.

Adding Images into Forms from External Sources using Paths

I've been searching around on Google to find a better way to show images in Access without actually inserting the image into the database.
I found this article 'http://support.microsoft.com/kb/285820' via this thread 'Is there a way to get ms-access to display images from external files' which goes into great detail on how to set paths to pictures through folders/files, and it works great, for a 'set' picture. However, I want a different picture to display when I switch to a different record.
Here is the code from the article:
Option Compare Database
Option Explicit
Public Function DisplayImage(ctlImageControl As Control, strImagePath As Variant) As String
On Error GoTo Err_DisplayImage
Dim strResult As String
Dim strDatabasePath As String
Dim intSlashLocation As Integer
With ctlImageControl
If IsNull(strImagePath) Then
.Visible = False
strResult = "No image name specified."
Else
If InStr(1, strImagePath, "\") = 0 Then
' Path is relative
strDatabasePath = CurrentProject.FullName
intSlashLocation = InStrRev(strDatabasePath, "\", Len(strDatabasePath))
strDatabasePath = Left(strDatabasePath, intSlashLocation)
strImagePath = strDatabasePath & strImagePath
End If
.Visible = True
.Picture = strImagePath
strResult = "Image found and displayed."
End If
End With
Exit_DisplayImage:
DisplayImage = strResult
Exit Function
Err_DisplayImage:
Select Case Err.Number
Case 2220 ' Can't find the picture.
ctlImageControl.Visible = False
strResult = "Can't find image in the specified name."
Resume Exit_DisplayImage:
Case Else ' Some other error.
MsgBox Err.Number & " " & Err.Description
strResult = "An error occurred displaying image."
Resume Exit_DisplayImage:
End Select
End Function
I have a feeling that I need to place a line of code that states something like, show image where Image.ID = "ID", but I can't figure out where to put it without getting errors. Am I over-looking something perhaps, or am I approaching this the wrong way? I just don't want to clutter my database, memory-wise, with .bmp images, but I feel like I am going to have to.
SOLVED: A much easier solution is as Gord Thompson has described below in the comments. And from my own experience, using this method for .bmp images leaves the picture distorted and out of contrast. I tested the image for .jpg and it worked perfectly! I hope this helps others who are having trouble with similar problems finds this post helpful.
The Microsoft Support article you cited applies to Access 2003. In Access 2010 (and later) there is a much simpler way to do it. All you need to do is place an Image control on the form and bind it to the field in your table that contains the path to the image file.
For example, with an [Employees] table like this
EmployeeID FirstName LastName PhotoPath
---------- --------- -------- ---------------------------------
1 Gord Thompson C:\Users\Public\Pictures\Gord.jpg
2 Hank Kingsley C:\Users\Public\Pictures\Hank.png
you could use an Image control whose Control Source is the [PhotoPath] field ...
... and the image will automatically be retrieved from the file specified
No VBA required.
Note also that the image files do not have to be .bmp files.
Added by an anonymous user:
For users of the Microsoft Office 365 version of MS Access (c. 2020), here is what you may need to know in order to get this terrific solution to work:
The [PhotoPath] field in its data table needs to be "Long Text" data type, if using long paths or long file names. The [PhotoPath] field format "Is Hyperlink" may need to be set to "No." I was getting additional, unwanted coding from Access on my text inputs. The [Image3] control may need to specify "Linked" rather than "Embedded."

Get organizationUnit from LDAP with VBA

I'm working with Access 2003 and already have a code that extracts a lot of data from LDAP. Here is what I got:
Set rootDSE = GetObject("LDAP://RootDSE")
domainContainer = rootDSE.Get("defaultNamingContext")
conn.provider = "ADSDSOObject"
conn.Open "ADs Provider"
ldapStr = "<LDAP://" & domainContainer & ">;(& (mailnickname=" & nickname & ") (| (&(objectCategory=person)(objectClass=user)(!(homeMDB=*))(!(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*))) ));adspath;subtree"
exchangeRS.Open ldapStr, conn, adOpenStatic, adLockReadOnly
exchangeRS.MoveFirst
Do Until exchangeRS.EOF
Set oUser = GetObject(exchangeRS.fields(0).value)
' The properties below are working
'oUser.firstName
'oUser.displayName
'oUser.title
'oUser.telephoneNumber
'oUser.mobile
'oUser.faxNumber
'oUser.streetAddress
'oUser.l
'oUser.postalCode
'oUser.mail
Next
I'm able to get a lot of informations for each person in the LDAP database. However, I would also like to get the structural unit. However, oUser.organizationUnit doesn't exit and oUser.OU only contains the top unit, which isn't what I want.
Is there any way to list all properties of oUser to find the right one? Is the ldapStr missing something?
Here is an image of what I want to get (sorry it it's in French):
Is it possible that this is not stored in LDAP? If not, any way to get it from Outlook address book? But I would really prefer getting it from LDAP actually, as every other single information is actually there (which tends me to believe this should be there too).
Look at the distinguishedName property. This is a sequence of relative distinguished names (RDN) which will include OUs
Here is the best method I've found for figuring out what data is in what fields. Dump the Schema to Text, then load that text back into Excel, little concatenate action to craft the output lines, then feed it back to VBA for it to dump all of the the data from AD so you can see what information is being stored where.
Step 1: Get your schema fields
Function SchemaToText()
Set objSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objSysInfo.userName)
Set objSchema = GetObject("LDAP://schema/user")
OutFile = Application.DefaultFilePath & "\schemalist.txt"
Debug.Print "Exporting to " & Application.DefaultFilePath & "\schemalist.txt"
Open OutFile For Output As #1
For Each strAttribute In objSchema.MandatoryProperties
Write #1, strAttribute
Next
For Each strAttribute In objSchema.OptionalProperties
Write #1, strAttribute
Next
Close #1
End Function
Step 2: All of your fields will have double quotes around them, so we'll need to remove those. Open schemalist.txt in Notepad (or other text editor of your choice), then use the replace function to find all of the double quotes and delete them
Step 3: Load schemalist.txt into a new spreadsheet in Excel (for the sake of this tutorial, we're assuming it's been placed into cell A1)
Step 4: Build write commands for dumping the field values - In cell B1, input the following:
=Concatenate("Write #1, ","""",".",A1,"|",""""," & .",A1)
You should now have something like this: Write #1, ".cn|" & .cn. Now you just need to fill that concatenate formula down for the entire schema list.
Step 5: Paste the write list into the following formula:
Function UserSchemaDump()
Set objSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objSysInfo.userName)
OutFile = Application.DefaultFilePath & "\schemadump.txt"
Debug.Print "Exporting to " & Application.DefaultFilePath & "\schemadump.txt"
Open OutFile For Output As #1
With objUser
'paste all of the write lines here
Write #1, ".cn|" & .cn
Write ...
Write #1, ".x500uniqueIdentifier|" & .x500uniqueIdentifier
End With
Close #1
Debug.Print "Export complete"
End Function
Step 6: Load schemadump.txt back into Excel, use text to columns to split on the |, then format as table with no headers and sort column 2 to see what fields are being utilized and what data is being placed in each field.
The result of all my testing showed me that this data isn't stored in LDAP.