you've probably noticed that access's design tools do not offer very aesthetic solutions. Adding media to tables is also very difficult.
However, there is a need to save pictures in many databases such as real estate, project management, material stock, product, personnel, logo,.
In this post, you will find how to get a picture for each record without increasing the database file size and how to display these pictures in forms.
In addition, with the VBA code I provide, you will be able to easily add this feature to your own database and start using it immediately.
Briefly; we will copy the image file to subfolder and add the file path to the field in the table.
We will use a function that combines the location of the database with the file path in the table. we're going to attach it to the picture frame.
In the first step, let's prepare the subfolders first. I open a folder named system or data under the folder where the database is located. I create another subfolder named images under this folder. The files will be copied here.
Add an image. change name "imgproject"
add two button, "+" and "-"
change name as "add project image" and "deleteprojectimage"
create a module and paste this code into your module
Option Compare Database
Public Const imagesubfolder = "system\images\"
''************************************************************************
'****** P A S T E T H I S C O D E T O t h e N E W M O D U L E ************
''************************************************************************
'PREPARE PATH
Function preparepath(ID As Integer)
Dim txt As String
Dim txtfilename As String
Dim x As Integer
Dim y As Integer
Dim basla As Date
'
txt = Application.CurrentProject.Path
txt = txt + "\system\images\" + LTrim$(Str$(ID))
txt = txt + txtimagename + ".jpg"
If Dir(txt) = "" Then
txt = Application.CurrentProject.Path
txt = txt + "\system\images\" + LTrim$(Str$(ID))
txt = txt + txtimagename + ".png"
End If
Debug.Print txt
preparepath = txt
End Function
Public Function GetcurrentDbPath()
Dim strDB As Variant
strDB = CurrentDb.Name
' txtx = InStr(1, strDB, "\")
strDB = (Application.CurrentProject.Path)
GetcurrentDbPath = strDB + "\"
End Function
Copy this code into your form'dsmodule
Option Compare Database
''*********************************************************************************
'****** T H I S C O D E T O Y O U R F O R M M O D U L E ************
''*********************************************************************************
Private Sub ADDprojectimage_Click()
'SELECT IMAGE DIALOG
Dim f As Office.FileDialog
Dim x As Variant
Dim strSQL As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim txtID As Integer
Set f = Application.FileDialog(3)
f.AllowMultiSelect = False
' Clear out the current filters
f.Filters.Clear
' Add a few custom filters
f.Filters.Add ".jpg", "*.jpg"
f.Filters.Add ".jpeg", "*.jpeg"
f.Filters.Add ".png", "*.png"
f.Filters.Add "All Files", "*.*"
f.InitialFileName = strCurrentDirP
' Show the dialog. If the method returns True, the user picked at least one file.
' If the method returns False, the user clicked Cancel.
If f.Show Then
Copy_Folder f.SelectedItems(1)
Me.imgproject.Requery
End If
End Sub
Sub deleteprojectimage_click()
On Error Resume Next
ToPath = GetcurrentDbPath + imagesubfolder + LTrim$(Str$(Me.ID)) + ".jpg"
If Dir(ToPath) <> "" Then
Kill (ToPath)
End If
ToPath = GetcurrentDbPath + imagesubfolder + LTrim$(Str$(Me.ID)) + ".png"
If Dir(ToPath) <> "" Then
Kill (ToPath)
End If
Me.imgproject.Requery
End Sub
Sub Copy_Folder(Picpath As String)
Dim FromPath As String
Dim ToPath As String
FromPath = Picpath
'FIND THE FILENAME ONLY
L = Len(FromPath)
For i = L To 1 Step -1
txtfilename = Mid$(FromPath, i, 1)
If txtfilename = "\" Then txtfilename = Right$(FromPath, L - i): Exit For
Next
'FIND THE FILENAME EXTENSION
L = Len(txtfilename)
For i = L To 1 Step -1
txtextension = Mid$(txtfilename, i, 1)
If txtextension = "." Then txtextension = Right$(txtfilename, L - i + 1): Exit For
Next
ToPath = GetcurrentDbPath + imagesubfolder + LTrim$(Str$(Me.ID)) + txtextension
ToPath = Replace(ToPath, " ", "_")
If Dir(ToPath) <> "" Then
Kill (ToPath)
End If
If FromPath <> ToPath Then
FileCopy FromPath, ToPath
End If
End Sub
Private Sub Form_Current()
Me.imgproject.Requery
End SubSave your form and open again
Select image
Change datasource as "=preparepath([ID])"
Finally, write "me.picname.requery" in the appropriate place of the "on-current" event of the
form
Hit the + button, select an image
The selected file will be automatically copied to the system/images folder we created and renamed as ID.jpg
That's it.
Let's try now.
I hope it will work for you.
Comments