File Location Tracking (1 Viewer)

smtazulislam

Member
Local time
Today, 04:15
Joined
Mar 27, 2020
Messages
806
Hello dear,
Hope all in well.
I want to create a Folder Image, NID Copy, Contract, Passport Copy, Employees Documents put in separate folder create with location tracked where is my database. I dont want to mentioned DRIVE locations. VBA can create automatically find database location.

An Example:
If my database in D:/ERP/maindata then FOLDER create also ERP Folder.

Need to upload button & Folder create VBA code. thank you.
Any help will appreciate..
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 09:15
Joined
May 7, 2009
Messages
19,169
create a table with your folder structure, eg:

tblFolders (table)
Entity (short text)
Value (short text)

Entity |Value
----------------------------------------------------------------------
"Main Folder" |"D:\ERP"
"Images" |"D:\ERP\Images"
"NID" |"D:\ERP\NID"
"Contract" |"D:\ERP\Conract"

''''

to save an Employee's Contract,
you use DLookup() to get the Contract folder and add thee EmployeeNumber (or PK Field).

DLookup("[Value]", "tblFolders", "Entity = 'Contract'") & "\" & [PKFieldValue of employee] & ".pdf"
 

smtazulislam

Member
Local time
Today, 04:15
Joined
Mar 27, 2020
Messages
806
create a table with your folder structure, eg:

tblFolders (table)
Entity (short text)
Value (short text)

Entity |Value
----------------------------------------------------------------------
"Main Folder" |"D:\ERP"
"Images" |"D:\ERP\Images"
"NID" |"D:\ERP\NID"
"Contract" |"D:\ERP\Conract"

''''

to save an Employee's Contract,
you use DLookup() to get the Contract folder and add thee EmployeeNumber (or PK Field).

DLookup("[Value]", "tblFolders", "Entity = 'Contract'") & "\" & [PKFieldValue of employee] & ".pdf"
Thank you so much.
That mean you indicate the path of Drive. But I dont like to give location that you put D:\ERP\Image. I give an example that
If my database in this Folder D:\ERP\ Or Any others Drive then VBA finding the database main file location of Folder than it is create Images folder Or NID Folder, what ever the given in the ADD IMAGE button in the form.

Maybe I can't explain it well. Ever you dont understand and if you like to upload my db. I can do it.

Mr. @arnelgp I see it before as same problem a thread you have solved. still 2 days I finding this thread, But I can't found it.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 09:15
Joined
May 7, 2009
Messages
19,169
so, just remove the Drive from the [Value]


Entity |Value
----------------------------------------------------------------------
"Images" |"Images"
"NID" |"NID"
"Contract" |"Contract"

using Currentproject.Path will return "D:\ERP\mainFolder"

so Images folder is in:

CurrentProject.Path & "\" & DLookup("[Value]", "tblFolders", "Entity = 'Images'")

if the folder does not exists, create a function that will create it:

public function fncForceMKDir(byval strPath As String)
dim var as variant
dim v as string
dim i as integer
var = split(strPath, "\")
on error resume next
for i = 0 to ubound(var)
v = v & var(i)
vba.mkdir v
v = v & "\"
next
end function
 

smtazulislam

Member
Local time
Today, 04:15
Joined
Mar 27, 2020
Messages
806
This is my code for Image (Employees Photo)

Code:
Private Sub CmdAddPicture_Click()
On Error GoTo HandleErr
'Dim strWindowTitle As String
Dim strFile As String
Dim strFilter As String
Dim fd As Office.FileDialog


    Set fd = Application.FileDialog(msoFileDialogFilePicker)
   
    With fd
        .Filters.Clear
        .Filters.Add "Images", "*.bmp;*.gif;*.ico;*.jpe;*.jpeg;*.jpg;*.png", 1
        .Filters.Add "All files", "*.*", 2
        'if single filed so FALSE, If allow Multi Selection image TRUE.
        .AllowMultiSelect = False
        If .Show = -1 Then
            strFile = (.SelectedItems(1))
        Else
            strFile = vbNullString
        End If
    End With
    Set fd = Nothing
   
Exit_Procedure:
    Exit Sub
       
ErrorHandler:
    MsgBox Err.Number, Err.Description
    Resume Exit_Procedure
    Resume

End Sub

And I create I module. that you give me previous message.

Code:
Public Function fncForceMKDir(ByVal strPath As String)
Dim var As Variant
Dim v As String
Dim i As Integer
var = Split(strPath, "\")
On Error Resume Next
For i = 0 To UBound(var)
v = v & var(i)
VBA.MkDir v
v = v & "\"
Next
End Function

Where I used DLOOKUP ?l
CurrentProject.Path & "\" & Dlookup("[Value]","Entity ='Images'"

Where I used function ?
fncForceMKDir

I don't guess it. please help.
 

moke123

AWF VIP
Local time
Yesterday, 21:15
Joined
Jan 11, 2013
Messages
3,852
It's not clear exactly what you want to do.

Your database is in the folder D:\ERP\maindata\YourDataBase.accdb

do you want the following folders?

D:\ERP\maindata\Image\
D:\ERP\maindata\NIDCopy\
D:\ERP\maindata\Contract\
D:\ERP\maindata\PassportCopy\
D:\ERP\maindata\EmployeeDocuments\

Or do you want a master employee folder with subfolders?

D:\ERP\maindata\YourEmployeeName\Image\
D:\ERP\maindata\YourEmployeeName\NIDCopy\
D:\ERP\maindata\YourEmployeeName\Contract\
D:\ERP\maindata\YourEmployeeName\PassportCopy\
D:\ERP\maindata\YourEmployeeName\EmployeeDocuments\
 

moke123

AWF VIP
Local time
Yesterday, 21:15
Joined
Jan 11, 2013
Messages
3,852
For a master employee folder with subfolders you could do something like this
'requires reference to Microsoft Scripting runtime

Code:
Sub CreateFolderStack(EmpName As String, EmpNumber As String)


    Dim strFolder As String    'EmpName & EmpNumber are concatenated to avoid duplicates


    strFolder = EmpName & "_" & EmpNumber


    ChkEmployeeFolder


    EmployeeFolderCreation strFolder


End Sub


Public Sub ChkEmployeeFolder()    'Check if "EmployeeFolders" folder exists and create it if doesn't exist


    If fFolderExists(CurrentProject.Path & "\EmployeeFolders") = False Then


        AddFldr CurrentProject.Path & "\EmployeeFolders "


    End If


End Sub


Public Sub EmployeeFolderCreation(strFolder As String)    'Add an employee folder And subfolders to employeefolders folder

    Dim TopFolder As String

    TopFolder = CurrentProject.Path & "\EmployeeFolders\" & strFolder

    If fFolderExists(TopFolder) = False Then

        AddFldr TopFolder

        AddSubFldr TopFolder, "Image"

        AddSubFldr TopFolder, "NIDCopy"

        AddSubFldr TopFolder, "Contract"

        AddSubFldr TopFolder, "PassportCopy"

        AddSubFldr TopFolder, "EmployeeDocuments"

    End If

End Sub

Function fFolderExists(F As String) As Boolean

    Dim fso As New FileSystemObject

    fFolderExists = fso.FolderExists(F)

End Function


Sub AddFldr(Fldr As String)

    Dim fso As New FileSystemObject

    fso.CreateFolder Fldr

End Sub


Sub AddSubFldr(ToFolder As String, FName As String)

    Dim Fldr As Folder

    Dim fso As New FileSystemObject

    Set Fldr = fso.GetFolder(ToFolder)

    fso.CreateFolder Fldr & "\" & FName

    Set Fldr = Nothing

End Sub

You would call it with

Code:
CreateFolderStack "John Doe", "1234"
 

smtazulislam

Member
Local time
Today, 04:15
Joined
Mar 27, 2020
Messages
806
It's not clear exactly what you want to do.

Your database is in the folder D:\ERP\maindata\YourDataBase.accdb

do you want the following folders?

D:\ERP\maindata\Image\
D:\ERP\maindata\NIDCopy\
D:\ERP\maindata\Contract\
D:\ERP\maindata\PassportCopy\
D:\ERP\maindata\EmployeeDocuments\

Or do you want a master employee folder with subfolders?

D:\ERP\maindata\YourEmployeeName\Image\
D:\ERP\maindata\YourEmployeeName\NIDCopy\
D:\ERP\maindata\YourEmployeeName\Contract\
D:\ERP\maindata\YourEmployeeName\PassportCopy\
D:\ERP\maindata\YourEmployeeName\EmployeeDocuments\

For a master employee folder with subfolders you could do something like this
'requires reference to Microsoft Scripting runtime

Code:
Sub CreateFolderStack(EmpName As String, EmpNumber As String)


    Dim strFolder As String    'EmpName & EmpNumber are concatenated to avoid duplicates


    strFolder = EmpName & "_" & EmpNumber


    ChkEmployeeFolder


    EmployeeFolderCreation strFolder


End Sub


Public Sub ChkEmployeeFolder()    'Check if "EmployeeFolders" folder exists and create it if doesn't exist


    If fFolderExists(CurrentProject.Path & "\EmployeeFolders") = False Then


        AddFldr CurrentProject.Path & "\EmployeeFolders "


    End If


End Sub


Public Sub EmployeeFolderCreation(strFolder As String)    'Add an employee folder And subfolders to employeefolders folder

    Dim TopFolder As String

    TopFolder = CurrentProject.Path & "\EmployeeFolders\" & strFolder

    If fFolderExists(TopFolder) = False Then

        AddFldr TopFolder

        AddSubFldr TopFolder, "Image"

        AddSubFldr TopFolder, "NIDCopy"

        AddSubFldr TopFolder, "Contract"

        AddSubFldr TopFolder, "PassportCopy"

        AddSubFldr TopFolder, "EmployeeDocuments"

    End If

End Sub

Function fFolderExists(F As String) As Boolean

    Dim fso As New FileSystemObject

    fFolderExists = fso.FolderExists(F)

End Function


Sub AddFldr(Fldr As String)

    Dim fso As New FileSystemObject

    fso.CreateFolder Fldr

End Sub


Sub AddSubFldr(ToFolder As String, FName As String)

    Dim Fldr As Folder

    Dim fso As New FileSystemObject

    Set Fldr = fso.GetFolder(ToFolder)

    fso.CreateFolder Fldr & "\" & FName

    Set Fldr = Nothing

End Sub

You would call it with

Code:
CreateFolderStack "John Doe", "1234"
Thank you so much.
I want to where I put this code.
Can you explain please.
 

bastanu

AWF VIP
Local time
Yesterday, 18:15
Joined
Apr 13, 2010
Messages
1,401
Is the database shared and split into front-end(s)/back-end? If yes you might want to consider having the subfolder structure built in the network location that hosts the back-end instead of using CurrentProject.Path. You can easily extract the location of the back by parsing the .Connect property of any linked table.

Cheers,
Vlad
 

moke123

AWF VIP
Local time
Yesterday, 21:15
Joined
Jan 11, 2013
Messages
3,852
Vlad has a good point.

If your using linked tables you can get the location of the backend with the code below. Just substitute the name of one of the linked tables as indicated. Then replace "CurrentProject.Path" in the code i wrote with GetBackendPath

Code:
Function GetBackendPath() As String
    Dim strBackEndPath As String
    Dim j As Integer

    strBackEndPath = CurrentDb.TableDefs("tblEmployees").Connect   'Add the name of a linked table as string inside ()

    j = InStrRev(strBackEndPath, "=") + 1

    strBackEndPath = Mid(strBackEndPath, j)

    strBackEndPath = Left(strBackEndPath, InStrRev(strBackEndPath, "\"))

    GetBackendPath = strBackEndPath

    'Debug.Print GetBackendPath

End Function

All the code I gave you would go in a standard module except for the last piece
Code:
CreateFolderStack "John Doe", "1234"
which would go where ever you are calling the code to create the folders.
 

smtazulislam

Member
Local time
Today, 04:15
Joined
Mar 27, 2020
Messages
806
Is the database shared and split into front-end(s)/back-end? If yes you might want to consider having the subfolder structure built in the network location that hosts the back-end instead of using CurrentProject.Path. You can easily extract the location of the back by parsing the .Connect property of any linked table.

Cheers,
Vlad
thank you so much Vlad.
I work Current project with .accdb. But my file in store in local server.
Because this corona effected I can't go to office. Using USB and work at home. Weekly we replace file in sever.
 
Last edited:

smtazulislam

Member
Local time
Today, 04:15
Joined
Mar 27, 2020
Messages
806
Vlad has a good point.

If your using linked tables you can get the location of the backend with the code below. Just substitute the name of one of the linked tables as indicated. Then replace "CurrentProject.Path" in the code i wrote with GetBackendPath

Code:
Function GetBackendPath() As String
    Dim strBackEndPath As String
    Dim j As Integer

    strBackEndPath = CurrentDb.TableDefs("tblEmployees").Connect   'Add the name of a linked table as string inside ()

    j = InStrRev(strBackEndPath, "=") + 1

    strBackEndPath = Mid(strBackEndPath, j)

    strBackEndPath = Left(strBackEndPath, InStrRev(strBackEndPath, "\"))

    GetBackendPath = strBackEndPath

    'Debug.Print GetBackendPath

End Function

All the code I gave you would go in a standard module except for the last piece
Code:
CreateFolderStack "John Doe", "1234"
which would go where ever you are calling the code to create the folders.
thank you.
I knock your inbox, Please check.
 

moke123

AWF VIP
Local time
Yesterday, 21:15
Joined
Jan 11, 2013
Messages
3,852
thank you.
I knock your inbox, Please check.
Sorry I dont use skype and I dont do any remote connections.

thank you so much Vlad.
I work Current project with .accdb. But my file in store in local server.
Because this corona effected I can't go to office. Using USB and work at home. Weekly we replace file in sever.
You should look into some remote desktop options like TeamViewer or GoToMyPc.

Why dont you post your DB with any private information removed. Compact it and put in a zip file and upload.
 

moke123

AWF VIP
Local time
Yesterday, 21:15
Joined
Jan 11, 2013
Messages
3,852
Here's a sample db.
There is a front and backend file in the zip file.
If you get prompted for the backend a file explororer will open so just navigate to the sample backend and choose it.

I included 2 list boxes. The first will show the folders for the employee. double click the list to open the folder.
When you select the first listbox it will list all the files in the selected folder in the second listbox. Double click the file to open it.
 

Attachments

  • Sample.zip
    95.9 KB · Views: 158

smtazulislam

Member
Local time
Today, 04:15
Joined
Mar 27, 2020
Messages
806
Here's a sample db.
There is a front and backend file in the zip file.
If you get prompted for the backend a file explororer will open so just navigate to the sample backend and choose it.

I included 2 list boxes. The first will show the folders for the employee. double click the list to open the folder.
When you select the first listbox it will list all the files in the selected folder in the second listbox. Double click the file to open it.
Thank you so much, I appreciated.
I try to open, but I can't. Have a message for path not found. attached picture
Any suggest.
 

Attachments

  • Capture.PNG
    Capture.PNG
    8.9 KB · Views: 226

smtazulislam

Member
Local time
Today, 04:15
Joined
Mar 27, 2020
Messages
806
Sorry I dont use skype and I dont do any remote connections.


You should look into some remote desktop options like TeamViewer or GoToMyPc.

Why dont you post your DB with any private information removed. Compact it and put in a zip file and upload.
Yes, I using TeamViewer. It is very 35+mb can't upload. I have more one problem is multiple pictures uploading. Need some change code.
 

Gasman

Enthusiastic Amateur
Local time
Today, 01:15
Joined
Sep 21, 2011
Messages
14,048
Thank you so much, I appreciated.
I try to open, but I can't. Have a message for path not found. attached picture
Any suggest.
And what did Moke123 say in post #14?

I had the same, but followed the simple instructions.
 

moke123

AWF VIP
Local time
Yesterday, 21:15
Joined
Jan 11, 2013
Messages
3,852
Yes I included JStreet relinker for just that reason.

When the error message comes up, close it and the explorer window should open up. Navigate to the folder with the backend and select it.

Alternatively use the linked table manager.

I have more one problem is multiple pictures uploading.
I hope your not storing them in an attachment field.
 

Users who are viewing this thread

Top Bottom