top of page

Link images to your Ms Access data

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



KnowIt Project Management
.zip
ZIP dosyasını indir • 5.03MB


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 Sub



Save 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.

121 görüntüleme0 yorum

Son Yazılar

Hepsini Gör

Comments


bottom of page